tebe Posted April 16, 2021 Share Posted April 16, 2021 (edited) Wave with MP http://atarionline.pl/forum/comments.php?DiscussionID=5979&page=1#Item_18 uses crt, atari, efast; const CHARSET_ADDRESS = $8000; var i: byte; ch: array [0..31] of byte absolute CHARSET_ADDRESS; begin chbas:=hi(CHARSET_ADDRESS); lmargin:=0; for i:=0 to 7 do ch[i+i*8]:=255; repeat poke(690, 255); write(#32#33#34#35#36#37#38#39#38#37#36#35#34#33); until keypressed; end. wave.7z Edited April 16, 2021 by tebe 3 Quote Link to comment Share on other sites More sharing options...
dmsc Posted April 16, 2021 Share Posted April 16, 2021 Hi! 59 minutes ago, tebe said: Wave with MP http://atarionline.pl/forum/comments.php?DiscussionID=5979&page=1#Item_18 uses crt, atari, efast; const CHARSET_ADDRESS = $8000; var i: byte; ch: array [0..31] of byte absolute CHARSET_ADDRESS; begin chbas:=hi(CHARSET_ADDRESS); lmargin:=0; for i:=0 to 7 do ch[i+i*8]:=255; repeat poke(690, 255); write(#32#33#34#35#36#37#38#39#38#37#36#35#34#33); until keypressed; end. Be careful! - The array is defined from 0...31, but used from 0 to 63. - The memory area is not cleared, so the program will only work of no other program was loaded first in that memory. Have Fun! 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted April 16, 2021 Share Posted April 16, 2021 (edited) DMSC, thank you for your vigilance uses crt, atari, efast; const CHARSET_ADDRESS = $8000; var i: byte; ch: array [0..255] of byte absolute CHARSET_ADDRESS; begin fillchar(ch, sizeof(ch), 0); chbas:=hi(word(@ch)); lmargin:=0; for i:=0 to 7 do ch[i+i*8]:=255; repeat poke(690, 255); write(#32#33#34#35#36#37#38#39#38#37#36#35#34#33); until keypressed; end. Edited April 16, 2021 by tebe 1 Quote Link to comment Share on other sites More sharing options...
zbyti Posted April 23, 2021 Share Posted April 23, 2021 (edited) @ilmenit you know Power C and PROMAL sieve_action.rc SIEVE rcdata 'action_sieve.xex' 6 main.pas {$r sieve_action.rc} const SIEVE = $4000; ATTRIBUTE_ADDR = $0800; SCREEN_ADDR = $0c00; CHARSET = $3000; var DETIRQSRC : byte absolute $ff09; SETIRQSRC : byte absolute $ff0a; RC : byte absolute $ff0b; TED_FF12 : byte absolute $ff12; CHBAS : byte absolute $ff13; IRQVEC : word absolute $fffe; var count : word absolute $ca; time : word absolute $cc; i, tmp : byte; procedure initFonts; begin Move(pointer($d000), pointer(CHARSET), $400); TED_FF12 := TED_FF12 and %11111011; CHBAS := (CHBAS and %11) or 12 shl 2; end; procedure printBinScore; begin FillChar(pointer(SCREEN_ADDR), 24 * 40, $20); tmp := 128; for i := 0 to 7 do begin if boolean(time and tmp) then poke(SCREEN_ADDR + i, $31) else poke(SCREEN_ADDR + i, $30); tmp := tmp shr 1; end; end; procedure vbi; assembler; interrupt; asm pha inc c4p_time+2 inc $14 mva #2 DETIRQSRC pla end; procedure initSystem; assembler; asm sei sta $ff3f lda #2 sta DETIRQSRC sta SETIRQSRC mva #204 RC mwa #VBI IRQVEC cli end; begin initFonts; pause; initSystem; pause; asm jsr SIEVE+$a end; printBinScore; repeat until false; end. Action! SIEVE code taken from https://atariwiki.org/wiki/Wiki.jsp?page=Review Action source and binary included in archive. Action.zip Edited April 23, 2021 by zbyti Quote Link to comment Share on other sites More sharing options...
zbyti Posted April 23, 2021 Share Posted April 23, 2021 (edited) action_sieve.act SET $E=$4000 SET $491=$4000 BYTE ARRAY FLAGS(8190) CARD I,K,PRIME CARD COUNT=$70 PROC SIEVE() COUNT=0 ; init count FOR I=0 TO 8190 ; and flags DO FLAGS(I)='T OD FOR I=0 TO 8190 DO IF FLAGS(I)='T THEN PRIME=I+I+3 K=I+PRIME WHILE K<=8190 DO FLAGS(K)='F K==+PRIME OD COUNT==+1 FI OD RETURN sieve_action.rc SIEVE rcdata 'action_sieve.xex' 6 main.pas {$r sieve_action.rc} const SIEVE = $4000; var count : word absolute $70; clock : byte absolute $a2; begin pause; clock := 0; asm jsr SIEVE+$a end; writeln('FRAMES COUNTER = ', clock); writeln('PROBE SIZE ', count); repeat until false; end. @ilmenit do your job Action_C64.zip Edited April 23, 2021 by zbyti 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted July 18, 2021 Share Posted July 18, 2021 c64 vbxe slideshow c64_vbxe.atr c64_vbxe.pas 6 1 Quote Link to comment Share on other sites More sharing options...
zbyti Posted July 18, 2021 Share Posted July 18, 2021 @tebe nice set of pics! Quote Link to comment Share on other sites More sharing options...
+Stephen Posted July 18, 2021 Share Posted July 18, 2021 6 hours ago, tebe said: c64 vbxe slideshow c64_vbxe.atr 179.64 kB · 8 downloads c64_vbxe.pas 2.7 kB · 4 downloads I tried this on my U1MB equipped machine. I had to set the RAM to stock else the display was corrupt. I have not tried in emulator to see if I can reproduce the issue. Cool project - thanks for the source! Quote Link to comment Share on other sites More sharing options...
tebe Posted July 19, 2021 Share Posted July 19, 2021 ATR is initialized with FoxDOS, program was compiled at address $0980 11 hours ago, tebe said: c64 vbxe slideshow c64_vbxe.atr 179.64 kB · 8 downloads c64_vbxe.pas 2.7 kB · 5 downloads Quote Link to comment Share on other sites More sharing options...
Signum Temporis Posted July 13, 2022 Share Posted July 13, 2022 (edited) Hi all! I'm back to 8-bit Atari after more than 30 years. I wrote a simple program in Mad-Pascal that draws and rotates Sierpiński carpet. I haven't used Pascal for around 28 years so I learn it again. RotatingSierpinskiCarpet.pas RotatingSierpinskiCarpet.xex (or run it now) The snippet on GitLab Comments to the program are welcome (here or there). Especially, how to draw a single frame faster. Regards Edited July 13, 2022 by Signum Temporis 6 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted July 13, 2022 Share Posted July 13, 2022 (edited) 4 hours ago, Signum Temporis said: Hi all! I'm back to 8-bit Atari after more than 30 years. I wrote a simple program in Mad-Pascal that draws and rotates Sierpiński carpet. I haven't used Pascal for around 28 years so I learn it again. welcom back thank you for the reported issues on github thank for the sophisticated example Edited July 13, 2022 by tebe 2 Quote Link to comment Share on other sites More sharing options...
bocianu Posted October 6, 2022 Share Posted October 6, 2022 (edited) Hi. Yesterday I wrote simple snake game in text mode. Just for fun. It has less than 130 lines of code, and maybe my example will be useful for you to learn something. program snake; uses atari, crt, joystick; const BOARD_SIZE = 24 * 40; TAIL_MAX = 1023; BORDER = ord(' '*~); FOOD = ord('+'~); BODY = ord('O'~); DEAD = ord('@'~); var tail: array [0..TAIL_MAX] of integer; headPos, headPtr, clearPtr, tailLength:word; b, speed, field, input:byte; dir: shortInt; gameover: boolean; procedure DrawSnake; begin b := BODY; if gameover then b := DEAD; Poke(headPos,b); end; procedure PutFood; var foodPos: word; begin repeat foodPos := savmsc + Random(BOARD_SIZE); until Peek(foodPos) = 0; Poke(foodPos, FOOD); end; procedure ClearTail; var offset: word; begin offset := 0; headPtr := (headPtr + 1) and TAIL_MAX; tail[headPtr] := headPos; if headPtr < clearPtr then offset := TAIL_MAX + 1; if headPtr + offset - clearPtr >= tailLength then begin if tail[clearPtr] <> tail[headPtr] then Poke(tail[clearPtr],0); clearPtr := (clearPtr + 1) and TAIL_MAX; end; end; procedure DrawBorder;inline; begin for b:=0 to 39 do begin poke(savmsc + b, BORDER); poke(savmsc + 23*40 + b, BORDER); if b<23 then begin poke(savmsc + b * 40, BORDER); poke(savmsc + b * 40 + 39, BORDER); end; end; end; procedure InitSnake;inline; begin headPos := savmsc + 20 + (12 * 40); // initial position mid screen (20,12) dir := 0; headPtr := 0; clearPtr := 0; tailLength := 5; speed := 8; tail[0] := headPos; gameover := false; end; procedure InitGame;inline; begin Randomize; InitSnake; CursorOff; ClrScr; DrawBorder; DrawSnake; PutFood; end; function GetInput:byte; begin result := joy_none; for b := 0 to speed do begin if stick0 <> joy_none then result := stick0; Pause; end; end; begin repeat InitGame; repeat input := GetInput until input <> joy_none; // wait for joy input to start repeat if (input = joy_left) and (dir <> 1) then dir := -1; if (input = joy_right) and (dir <> -1) then dir := 1; if (input = joy_up) and (dir <> 40) then dir := -40; if (input = joy_down) and (dir <> -40) then dir := 40; headPos := headPos + dir; ClearTail; field := Peek(headPos); case (field) of FOOD: begin // hit food PutFood; Inc(tailLength); end; 0: // empty field - do nothing ; else gameover := true; // hit antyhing else end; DrawSnake; input := GetInput; until gameover; Readkey; // wait for any key to restart until false; end. snake.xex Edited October 6, 2022 by bocianu 7 Quote Link to comment Share on other sites More sharing options...
rdefabri Posted October 6, 2022 Share Posted October 6, 2022 4 hours ago, bocianu said: Hi. Yesterday I wrote simple snake game in text mode. Just for fun. It has less than 130 lines of code, and maybe my example will be useful for you to learn something. program snake; uses atari, crt, joystick; const BOARD_SIZE = 24 * 40; TAIL_MAX = 1023; BORDER = ord(' '*~); FOOD = ord('+'~); BODY = ord('O'~); DEAD = ord('@'~); var tail: array [0..TAIL_MAX] of integer; headPos, headPtr, clearPtr, tailLength:word; b, speed, field, input:byte; dir: shortInt; gameover: boolean; procedure DrawSnake; begin b := BODY; if gameover then b := DEAD; Poke(headPos,b); end; procedure PutFood; var foodPos: word; begin repeat foodPos := savmsc + Random(BOARD_SIZE); until Peek(foodPos) = 0; Poke(foodPos, FOOD); end; procedure ClearTail; var offset: word; begin offset := 0; headPtr := (headPtr + 1) and TAIL_MAX; tail[headPtr] := headPos; if headPtr < clearPtr then offset := TAIL_MAX + 1; if headPtr + offset - clearPtr >= tailLength then begin if tail[clearPtr] <> tail[headPtr] then Poke(tail[clearPtr],0); clearPtr := (clearPtr + 1) and TAIL_MAX; end; end; procedure DrawBorder;inline; begin for b:=0 to 39 do begin poke(savmsc + b, BORDER); poke(savmsc + 23*40 + b, BORDER); if b<23 then begin poke(savmsc + b * 40, BORDER); poke(savmsc + b * 40 + 39, BORDER); end; end; end; procedure InitSnake;inline; begin headPos := savmsc + 20 + (12 * 40); // initial position mid screen (20,12) dir := 0; headPtr := 0; clearPtr := 0; tailLength := 5; speed := 8; tail[0] := headPos; gameover := false; end; procedure InitGame;inline; begin Randomize; InitSnake; CursorOff; ClrScr; DrawBorder; DrawSnake; PutFood; end; function GetInput:byte; begin result := joy_none; for b := 0 to speed do begin if stick0 <> joy_none then result := stick0; Pause; end; end; begin repeat InitGame; repeat input := GetInput until input <> joy_none; // wait for joy input to start repeat if (input = joy_left) and (dir <> 1) then dir := -1; if (input = joy_right) and (dir <> -1) then dir := 1; if (input = joy_up) and (dir <> 40) then dir := -40; if (input = joy_down) and (dir <> -40) then dir := 40; headPos := headPos + dir; ClearTail; field := Peek(headPos); case (field) of FOOD: begin // hit food PutFood; Inc(tailLength); end; 0: // empty field - do nothing ; else gameover := true; // hit antyhing else end; DrawSnake; input := GetInput; until gameover; Readkey; // wait for any key to restart until false; end. snake.xex 1.53 kB · 5 downloads Is there a version with comments so we can understand what function / command each line is performing? Thanks for sharing it - I can make some of it out, but I'm less Pascal centric, and there must be some Atari specific things here that are over my head. Quote Link to comment Share on other sites More sharing options...
bocianu Posted October 6, 2022 Share Posted October 6, 2022 (edited) 31 minutes ago, rdefabri said: Is there a version with comments so we can understand what function / command each line is performing? Any particular place you wish me to explain in details? I think that most of the code is self explanatory. I tried to use comprehensible variable and function names: headPos - contains snake head position, tail - array containing snake's tail positions DrawSnake - draws snakes new position, ClearTail - clears Tail chars if it gets too long (based on tailLength), and so on... All screen positions are stored as direct video memory addresses, so if you poke at headPos it draws directly on screen, if you peek position you get charCode at that position. To move the snake, the direction variable is added to headPos, to get new position of snake's head on screen. That's why direction variable valid values are -1 (move one column left) 1 (one column right) -40 (one row up) 40 (one row down) just ask what is unclear, I will try to explain it Edited October 6, 2022 by bocianu 1 Quote Link to comment Share on other sites More sharing options...
rdefabri Posted October 7, 2022 Share Posted October 7, 2022 23 hours ago, bocianu said: Any particular place you wish me to explain in details? I think that most of the code is self explanatory. I tried to use comprehensible variable and function names: headPos - contains snake head position, tail - array containing snake's tail positions DrawSnake - draws snakes new position, ClearTail - clears Tail chars if it gets too long (based on tailLength), and so on... All screen positions are stored as direct video memory addresses, so if you poke at headPos it draws directly on screen, if you peek position you get charCode at that position. To move the snake, the direction variable is added to headPos, to get new position of snake's head on screen. That's why direction variable valid values are -1 (move one column left) 1 (one column right) -40 (one row up) 40 (one row down) just ask what is unclear, I will try to explain it Thx! Nothing specifically, just trying to understand what I can. I haven't gone through it in detail, so when I do, I'll provide some questions. Quote Link to comment Share on other sites More sharing options...
tebe Posted November 12, 2022 Share Posted November 12, 2022 (edited) {This is an LZH compression routine used in BRANCH version 0.97. } {Most of the code here is adapted from LZHSRC10.??? } { The file LZHUF.C is originally written in C. I have re-written it in PASCAL. } changes to fit in $2000..$AFFF space, small 10KB buffer, compress/decompress one file (10KB) LZHUF.COM E D:INFILE.DAT D:OUTFILE.LZH LZHUF.COM D D:INFILE.LZH D:OUTFILE.DAT possibility to compile for PC and XE/XL, MP compiler passed the test LZHSRC97.PAS lzhuf.atr Edited November 12, 2022 by tebe 4 Quote Link to comment Share on other sites More sharing options...
tebe Posted December 15, 2022 Share Posted December 15, 2022 https://github.com/drmortalwombat/oscar64/blob/main/samples/hires/fractaltree.c fractal_tree.obx fractal_tree.pas 5 Quote Link to comment Share on other sites More sharing options...
tebe Posted April 2, 2023 Share Posted April 2, 2023 MP 1.6.7 3D with FLOAT16 https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d.pas the same code with SHORTREAL + FASTMUL {$F page} https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d_shortreal.pas 3d.obx 3d_shortreal.obx 5 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted April 2, 2023 Share Posted April 2, 2023 ATASCII COMPO https://gitlab.com/bocianu/atasciicompo3 6 1 Quote Link to comment Share on other sites More sharing options...
Gury Posted April 2, 2023 Author Share Posted April 2, 2023 9 hours ago, tebe said: MP 1.6.7 3D with FLOAT16 https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d.pas the same code with SHORTREAL + FASTMUL {$F page} https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d_shortreal.pas 3d.obx 7.59 kB · 4 downloads 3d_shortreal.obx 7.52 kB · 4 downloads Now this is something to watch... Fast moving 3-D wireframe object... Also, everybody can learn from this easy-to-read structured Pascal code. Good stuff, Tebe 👍🍻 Quote Link to comment Share on other sites More sharing options...
+JAC! Posted April 7, 2023 Share Posted April 7, 2023 On 4/2/2023 at 4:28 PM, tebe said: 3D with FLOAT16 https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d.pas the same code with SHORTREAL + FASTMUL {$F page} https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d_shortreal.pas 3d.obx 7.59 kB · 10 downloads 3d_shortreal.obx 7.52 kB · 10 downloads That's really an amazing show case! Quote Link to comment Share on other sites More sharing options...
zbyti Posted April 8, 2023 Share Posted April 8, 2023 On 4/2/2023 at 4:28 PM, tebe said: MP 1.6.7 3D with FLOAT16 https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d.pas the same code with SHORTREAL + FASTMUL {$F page} https://github.com/tebe6502/Mad-Pascal/blob/dev/samples/a8/demoeffects/3d_shortreal.pas 3d.obx 7.59 kB · 12 downloads 3d_shortreal.obx 7.52 kB · 12 downloads Mad Pascal libraries 😁 1 Quote Link to comment Share on other sites More sharing options...
tebe Posted October 26, 2023 Share Posted October 26, 2023 unit GRAPH update: DrawPoly, FillPoly procedure DrawPoly(amount: byte; var vertices); (* @description: Draw polygon *) var i: byte; P, Q: PWord; begin P:=@vertices; Q:=@vertices; for i:=0 to amount-2 do begin Line(P[0], P[1], P[2], P[3]); inc(P, 2); end; Line(Q[0], Q[1], P[0], P[1]); end; procedure FillPoly(amount: byte; var vertices); (* @description: Fill polygon Adapted from http://alienryderflex.com/polygon_fill/ https://github.com/tuupola/hagl/blob/master/src/hagl_polygon.c *) var i, j, y, miny, maxy, count: byte; P, Q: PWord; x0,y0,x1,y1, swap: word; nodes: array [0..63] of word; begin miny := 255; maxy := 0; P:=@vertices; for i := 0 to amount-1 do begin if (miny > P[1]) then miny := P[1]; if (maxy < P[1]) then maxy := P[1]; inc(P, 2); end; // Loop through the rows of the image. for y := miny to maxy-1 do begin // Build a list of nodes. count := 0; j := amount - 1; P:=@vertices; Q:=@vertices + j shl 2; for i := 0 to amount-1 do begin x0 := P[0]; y0 := P[1]; x1 := Q[0]; y1 := Q[1]; if ( ((y0 < y) and (y1 >= y)) or ((y1 < y) and (y0 >= y)) ) then begin nodes[count] := trunc(x0 + (y - y0) / (y1 - y0) * (x1 - x0)); inc(count); end; Q:=P; inc(P, 2); end; // Sort the nodes, via a simple 'Bubble' sort. i := 0; while (i < count - 1) do begin if (nodes[i] > nodes[i + 1]) then begin swap := nodes[i]; nodes[i] := nodes[i + 1]; nodes[i + 1] := swap; if i<>0 then dec(i); end else inc(i); end; // Draw lines between nodes. i:=0; while i < count do begin Hline(nodes[i], nodes[i + 1], y); inc(i, 2); end; end; end; polygon.obx polygon.pas 3 Quote Link to comment Share on other sites More sharing options...
tebe Posted November 3, 2023 Share Posted November 3, 2023 color cycle sample circle_cycle.obx circle_cycle.pas line_cycle.obx line_cycle.pas 3 3 Quote Link to comment Share on other sites More sharing options...
tebe Posted November 3, 2023 Share Posted November 3, 2023 (edited) square_cycle.obx square_cycle.pas Edited November 3, 2023 by tebe 4 1 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.