tebe Posted July 16, 2018 Share Posted July 16, 2018 { Just a test of 3-frame snake-bob animation. By Bill Kendrick 12/29/94. After watching the DragonBob part of Slight's "Bitter Reality" megademo, I decided to try my hand at the animation routine. (I should use the display list, but was lazy). The animation is done by having three screens which are constantly flipped through. An object ("bob"), in this case a small circle, is moved around the screen. It is placed on the current screen, so when the next frame appears, it is gone. In the next frame after THAT, it is gone as well. Finally, in the NEXT frame, it reappears. It sounds dumb, but when it's moving, it looks like they are ALL constantly moving. (Oh, and you use THREE frames because if you used only two, there'd be only motion and no DIRECTION). -bill! kendrick@vax.sonoma.edu } uses crt, graph, joystick; var ss: array [0..2, 0..1920-1] of byte; q: byte; x, y, xm, ym: smallint; sc: pointer; begin InitGraph(6+16); sc:=pointer(dpeek(88)); SetColor(1); repeat pause; inc(q); if q > 2 then q:=0; move(@ss[q,0], sc, 1920); if strig0=1 then begin inc(x, xm); inc(y, ym) end; if x>=152 then begin x:=152; xm:=-(random(3)+1) end; if x<=0 then begin x:=0; xm:=random(3)+1 end; if y>=88 then begin y:=88; ym:=-(random(3)+1) end; if y<=0 then begin y:=0; ym:=random(3)+1 end; Circle(x+4, y+4, 2); move(sc, @ss[q][0], 1920); until keypressed; end. bobs.zip 1 Quote Link to comment Share on other sites More sharing options...
funkheld Posted October 3, 2018 Share Posted October 3, 2018 what is this : intr(iVBL, @scroll); intr(iDLI, @dli); intr not found. greeting Quote Link to comment Share on other sites More sharing options...
tebe Posted October 3, 2018 Share Posted October 3, 2018 https://www.freepascal.org/docs-html/rtl/dos/intr.html Quote Link to comment Share on other sites More sharing options...
funkheld Posted October 3, 2018 Share Posted October 3, 2018 where can I find it in Madpascal? I can not integrate it. greeting Quote Link to comment Share on other sites More sharing options...
tebe Posted October 3, 2018 Share Posted October 3, 2018 (edited) it's build in INTR is replaced by GETINTVEC, SETINTVEC (12.06.2016) GETINTVECTOK: begin CheckTok(i + 1, OPARTOK); i := CompileConstExpression(i + 2, ConstVal, ActualParamType); GetCommonType(i, INTEGERTOK, ActualParamType); CheckTok(i + 1, COMMATOK); if not(ConstVal in [0..1]) then Error(i, 'Interrupt Number in [0..1]'); CheckTok(i + 2, IDENTTOK); IdentIndex := GetIdent(Tok[i + 2].Name^); if IdentIndex = 0 then iError(i + 2, UnknownIdentifier); if not (Ident[IdentIndex].DataType in Pointers) then iError(i + 2, IncompatibleTypes, 0, Ident[IdentIndex].DataType , POINTERTOK); svar := GetLocalName(IdentIndex); inc(i, 2); case ConstVal of ord(iDLI): begin asm65(''); asm65(#9'lda VDSLST'); asm65(#9'sta '+svar); asm65(#9'lda VDSLST+1'); asm65(#9'sta '+svar+'+1'); end; ord(iVBL): begin asm65(''); asm65(#9'lda VVBLKD'); asm65(#9'sta '+svar); asm65(#9'lda VVBLKD+1'); asm65(#9'sta '+svar+'+1'); end; end; CheckTok(i + 1, CPARTOK); // GenerateInterrupt(InterruptNumber); Result := i + 1; end; SETINTVECTOK: begin CheckTok(i + 1, OPARTOK); i := CompileConstExpression(i + 2, ConstVal, ActualParamType); GetCommonType(i, INTEGERTOK, ActualParamType); CheckTok(i + 1, COMMATOK); StartOptimization(i + 1); if not(ConstVal in [0..1]) then Error(i, 'Interrupt Number in [0..1]'); i := CompileExpression(i + 2, ActualParamType); GetCommonType(i, POINTERTOK, ActualParamType); case ConstVal of ord(iDLI): begin asm65(#9'mva :STACKORIGIN,x VDSLST'); asm65(#9'mva :STACKORIGIN+STACKWIDTH,x VDSLST+1'); a65(__subBX); end; ord(iVBL): begin asm65(#9'lda :STACKORIGIN,x'); asm65(#9'ldy #5'); asm65(#9'sta wsync'); asm65(#9'dey'); asm65(#9'rne'); asm65(#9'sta VVBLKD'); asm65(#9'ldy :STACKORIGIN+STACKWIDTH,x'); asm65(#9'sty VVBLKD+1'); a65(__subBX); end; end; Edited October 3, 2018 by tebe Quote Link to comment Share on other sites More sharing options...
funkheld Posted October 3, 2018 Share Posted October 3, 2018 (edited) ------------------------------------------- INTR is replaced by GETINTVEC, SETINTVEC ------------------------------- Hi good afternoon. where do i find the routine? in which folder can I read it please. greeting. Edited October 4, 2018 by funkheld Quote Link to comment Share on other sites More sharing options...
tebe Posted November 22, 2018 Share Posted November 22, 2018 DYCP, narrow screen dycp_narrow.zip 4 Quote Link to comment Share on other sites More sharing options...
tebe Posted November 23, 2018 Share Posted November 23, 2018 pm_starfield uses crt, atari; var i: byte; tab, add: array [0..255] of byte; begin for i:=0 to 255 do begin tab[i]:=peek($d20a); add[i]:=peek($d20a) and 3 + 1; end; sizep0:=0; grafp0:=1; repeat i:=vcount; wsync:=0; hposp0:=tab[i]; inc(tab[i], add[i]); until keypressed; end. pm_starfield.zip 3 Quote Link to comment Share on other sites More sharing options...
tebe Posted November 27, 2018 Share Posted November 27, 2018 (edited) hscroll by Bocianu blibs, https://gitlab.com/bocianu/blibs program hscroll; {$librarypath blibs} uses atari, b_dl; const dlist = $5000; vmem = $5100; var hscroll:byte = 3; offset:byte = 0; blankSize:byte = 0; s:string = 'hello! it is an jumping pascal scroll!!'~; blanks:array[0..15] of byte = ( DL_BLANK8, DL_BLANK7, DL_BLANK6, DL_BLANK5, DL_BLANK4, DL_BLANK3, DL_BLANK2, DL_BLANK1, DL_BLANK1, DL_BLANK2, DL_BLANK3, DL_BLANK4, DL_BLANK5, DL_BLANK6, DL_BLANK7, DL_BLANK8 ); begin DL_Init(dlist); DL_Push(DL_BLANK8, 12); // 12 blank lines DL_Push(DL_MODE_40x24T2 + DL_HSCROLL + DL_LMS, vmem); // textline DL_Push(DL_JVB, dlist); // jump back DL_Start; move(s[1],pointer(vmem+42),sizeOf(s)); // copy text to vram color2:=0; repeat pause; if hscroll = $ff then begin // $ff is one below zero hscroll := 3; offset := (offset + 1) mod 80; // go trough 0-79 DL_PokeW(13, vmem + offset); // set new memory offset end; hscrol := hscroll; // set hscroll dec(hscroll); blankSize := (blankSize + 1) and 15; // go trough 0-15 DL_Poke(10, blanks[blankSize]); // set new blankline height until false; end. hscroll.zip Edited November 27, 2018 by tebe 1 Quote Link to comment Share on other sites More sharing options...
Gury Posted November 28, 2018 Author Share Posted November 28, 2018 The best thing about Mad Pascal is how short the code is for resulting effect take place. And of course, it is fast and binary is small. 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted December 7, 2018 Share Posted December 7, 2018 (edited) few examples about cross compiling PC / ATARI 8bit mp_pc_atari.zip Edited December 7, 2018 by tebe 1 Quote Link to comment Share on other sites More sharing options...
pirx Posted December 9, 2018 Share Posted December 9, 2018 Happy birthday tebe!!!! 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted February 15, 2019 Share Posted February 15, 2019 Vasiliy Tereshkov "My Pascal compiler and Polish contemporary art" https://habr.com/en/post/440372/?fbclid=IwAR3JZRGaCP3d0SGp2BnLg7IpXNa0gw3ITtjgVKu0iFXdQz-1U-b5fr6Nqqo 5 Quote Link to comment Share on other sites More sharing options...
_The Doctor__ Posted February 15, 2019 Share Posted February 15, 2019 Vasiliy Tereshkov "My Pascal compiler and Polish contemporary art" https://habr.com/en/post/440372/?fbclid=IwAR3JZRGaCP3d0SGp2BnLg7IpXNa0gw3ITtjgVKu0iFXdQz-1U-b5fr6Nqqo Very happy to click that link. I enjoyed reading it. Quote Link to comment Share on other sites More sharing options...
gawor Posted January 20, 2020 Share Posted January 20, 2020 Random-dot stereogram generator - my first project made with Mad Pascal. Code optimized for readability, not speed. stereogr.zip 4 1 Quote Link to comment Share on other sites More sharing options...
zbyti Posted December 14, 2020 Share Posted December 14, 2020 Sprite example WIP tut.mp4 main.xex 1 Quote Link to comment Share on other sites More sharing options...
xxl Posted December 14, 2020 Share Posted December 14, 2020 On 1/20/2020 at 3:08 PM, gawor said: Random-dot stereogram generator - my first project made with Mad Pascal. Code optimized for readability, not speed. stereogr.zip 9.96 kB · 20 downloads this is great!!!! have you tried colored in GTIA modes? Quote Link to comment Share on other sites More sharing options...
zbyti Posted December 15, 2020 Share Posted December 15, 2020 Oh, well, I forgot provide some snippet. procedure vbi; interrupt; begin asm { phr }; //------------------> test <------------------- if (RTCLOK and %11) = 0 then begin if (TRIG0 = 0) then Poke(dl2Lms + bCannonX + wCannonY,2); end; if dl2Lms > GAME_LMS_EMD then Dec(dl2Lms) else dl2Lms := GAME_LMS; wTmp1 := dl2Lms; asm { ldx #GAME_SCREEN_ROWS ldy #0 clr: tya sta (GLOBALS.WTMP1),y lda GLOBALS.WTMP1 add #40 sta GLOBALS.WTMP1 bcc @+ inc GLOBALS.WTMP1+1 @: dex bpl clr }; //------------------> end <-------------------- asm { plr }; end; of course when dl2Lms reach GAME_LMS_EMD coarse scroll will not loop in the final (tutorial) game. Quote Link to comment Share on other sites More sharing options...
zbyti Posted December 17, 2020 Share Posted December 17, 2020 (edited) I decided release whole source, maybe someone find it useful? game-sources.zip main.xex Edited December 17, 2020 by zbyti xex 1 Quote Link to comment Share on other sites More sharing options...
Gury Posted December 17, 2020 Author Share Posted December 17, 2020 Wonderful, I will analyze the code. I tried the game, moving around and shooting at the stars, but didn't get any score yet. 1 Quote Link to comment Share on other sites More sharing options...
zbyti Posted December 17, 2020 Share Posted December 17, 2020 (edited) Yes, its starter code only because desire to write in K65 has won in me and so far I am putting it off, indefinitely But "I'll be back" Edited December 17, 2020 by zbyti I'll be back Quote Link to comment Share on other sites More sharing options...
zbyti Posted December 17, 2020 Share Posted December 17, 2020 30 minutes ago, Gury said: I tried the game, moving around and shooting at the stars, but didn't get any score yet. 1 Quote Link to comment Share on other sites More sharing options...
Gury Posted December 17, 2020 Author Share Posted December 17, 2020 Probably, if my aim will be good enough It will be very interesting to see which will prevail for you, K65 probably. I see you have more love for Pascal-like languages than C. KickC brought more interest of all choices for this language, I suppose. Quote Link to comment Share on other sites More sharing options...
tebe Posted December 26, 2020 Share Posted December 26, 2020 (edited) On 12/15/2020 at 1:45 PM, zbyti said: Oh, well, I forgot provide some snippet. procedure vbi; interrupt; begin asm { phr }; //------------------> test <------------------- if (RTCLOK and %11) = 0 then begin if (TRIG0 = 0) then Poke(dl2Lms + bCannonX + wCannonY,2); end; if dl2Lms > GAME_LMS_EMD then Dec(dl2Lms) else dl2Lms := GAME_LMS; wTmp1 := dl2Lms; asm { ldx #GAME_SCREEN_ROWS ldy #0 clr: tya sta (GLOBALS.WTMP1),y lda GLOBALS.WTMP1 add #40 sta GLOBALS.WTMP1 bcc @+ inc GLOBALS.WTMP1+1 @: dex bpl clr }; //------------------> end <-------------------- asm { plr }; end; of course when dl2Lms reach GAME_LMS_EMD coarse scroll will not loop in the final (tutorial) game. do not mix Pascal code with the assembler in the INTERRUPT block, it is very dangerous, leads to unstable program operation Pascal code reused variable :BP, :BP2, :STACKORIGIN+XX, X register Edited December 26, 2020 by tebe Quote Link to comment Share on other sites More sharing options...
zbyti Posted December 26, 2020 Share Posted December 26, 2020 (edited) 3 hours ago, tebe said: do not mix Pascal code with the assembler in the INTERRUPT block, it is very dangerous, leads to unstable program operation Pascal code reused variable :BP, :BP2, :STACKORIGIN+XX, X register Yes, I learnt this case (with X register) writing copy ship procedure. procedure copyShip; assembler; asm { ldy #>P0_ADR sty p0Ship+2 sty clrP0+2 iny sty p1Ship+2 sty clrP1+2 ldy BSHIPY sty p0Ship+1 sty p1Ship+1 ;move ldy #GFX_SHIP_SEG-1 @: lda GFX_SHIP_ADR,y p0Ship: sta P0_ADR,y lda GFX_SHIP_ADR+GFX_SHIP_SEG,y p1Ship: sta P1_ADR,y dey bpl @- ;clear ldy BSHIPY lda JOY.JOYDIRECTION and #%0011 cmp #JOY_DOWN beq @+ tya add #SHIP_Y_STEP*2 bne @+1 @: tya sub #SHIP_Y_STEP @: sta clrP0+1 sta clrP1+1 lda #0 ldy #GFX_SHIP_SEG-SHIP_Y_STEP-1 clrP0: sta P0_ADR,y clrP1: sta P1_ADR,y dey bpl clrP0 }; end; But now I move this stuff to X16 and on this platform ASM in Mad Pascal will not be justified because on 8MHz + VERA Mad Pascal is fast enough to not bother with MADS snippets. Edited December 26, 2020 by zbyti typo Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.