mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-29 21:49:17 +00:00
256 lines
16 KiB
Forth
256 lines
16 KiB
Forth
|
\ *** Block No. 0 Hexblock 0
|
|||
|
|
\\ *** Graphic - Demonstrationen *** 26may86we
|
|||
|
|
|
|||
|
|
Dieses File enth<EFBFBD>lt einige Graphic-Demos, die von den Line-A
|
|||
|
|
Routinen Gebrauch machen.
|
|||
|
|
|
|||
|
|
Hier bietet sich auch dem Anf<EFBFBD>nger ein weites Feld f<EFBFBD>r eigene
|
|||
|
|
Versuche. Mit CHECKING ON kann man die gr<EFBFBD>bsten Fehler abfan-
|
|||
|
|
gen, alledings auf Kosten der Geschwindigkeit.
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 1 Hexblock 1
|
|||
|
|
\ Demo Loadscreen 21sep86we
|
|||
|
|
|
|||
|
|
\needs Graphics include line_a.scr
|
|||
|
|
|
|||
|
|
Onlyforth Graphics also definitions
|
|||
|
|
1 &11 +thru
|
|||
|
|
|
|||
|
|
moire
|
|||
|
|
kaleidos
|
|||
|
|
lines
|
|||
|
|
boxes
|
|||
|
|
rechtecke
|
|||
|
|
rechtecke1
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 2 Hexblock 2
|
|||
|
|
\ patterns 18sep86we
|
|||
|
|
|
|||
|
|
1 ?head !
|
|||
|
|
: !pattern ( d -- ) Create , , ;
|
|||
|
|
|
|||
|
|
$C000.C000 !pattern p1 $CCCC.3333 !pattern p2
|
|||
|
|
$C0C0.3030 !pattern p3 $0303.0C0C !pattern p4
|
|||
|
|
$C003.300C !pattern p5 $C3C3.3C3C !pattern p6
|
|||
|
|
$FFFF.8001 !pattern p7 $40A0.8040 !pattern p8
|
|||
|
|
$4444.0000 !pattern p9 $FFFF.2222 !pattern p10
|
|||
|
|
$4444.8282 !pattern p11 $8080.8888 !pattern p12
|
|||
|
|
$0000.1010 !pattern p13 $0101.8080 !pattern p14
|
|||
|
|
$7777.8888 !pattern p15 $7E7E.8181 !pattern p16
|
|||
|
|
$E640.FFFF !pattern p17 $3838.C6C6 !pattern p18
|
|||
|
|
|
|||
|
|
0 ?head !
|
|||
|
|
\ *** Block No. 3 Hexblock 3
|
|||
|
|
\ patterns 21may86we
|
|||
|
|
|
|||
|
|
Create patterns p1 , p2 , p3 , p4 , p5 , p6 ,
|
|||
|
|
p7 , p8 , p9 , p10 , p11 , p12 ,
|
|||
|
|
p13 , p14 , p15 , p16 , p17 , p18 ,
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 4 Hexblock 4
|
|||
|
|
\ diamonds 20sep86we
|
|||
|
|
|
|||
|
|
| : yscale &400 &640 */ ;
|
|||
|
|
|
|||
|
|
: diamond ( size -- )
|
|||
|
|
>r cur_x @ cur_y @
|
|||
|
|
2dup swap r@ - swap 2swap 2over set
|
|||
|
|
2dup r@ yscale - draw
|
|||
|
|
2dup swap r@ + swap draw
|
|||
|
|
2dup r> yscale + draw
|
|||
|
|
2swap draw set ;
|
|||
|
|
|
|||
|
|
: big_diamond 2 wr_mode !
|
|||
|
|
&319 0 &639 &200 &319 &399 0 &200 4 polygon ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 5 Hexblock 5
|
|||
|
|
\ some usefull definitions 20sep86we
|
|||
|
|
|
|||
|
|
: overwrite 0 wr_mode ! ;
|
|||
|
|
: exorwrite 2 wr_mode ! ;
|
|||
|
|
|
|||
|
|
| : home get_res scr_res ! 0 0 set ;
|
|||
|
|
| : center &320 &200 set ;
|
|||
|
|
|
|||
|
|
| : wait BEGIN pause key? UNTIL &25 0 at
|
|||
|
|
getkey $FF and #esc = abort" stopped" ;
|
|||
|
|
|
|||
|
|
| : logo &117 0 DO ." volksFORTH 83 " LOOP ;
|
|||
|
|
|
|||
|
|
| : titel
|
|||
|
|
&21 &24 at ." *** v o l k s F O R T H *** "
|
|||
|
|
&22 &31 at ." Line-A Graphic " ;
|
|||
|
|
\ *** Block No. 6 Hexblock 6
|
|||
|
|
\ patterns example 18sep86we
|
|||
|
|
|
|||
|
|
: muster
|
|||
|
|
page overwrite 1 pat_mask !
|
|||
|
|
$10 0 DO patterns I 2* + @ pattern !
|
|||
|
|
$10 I $10 * + dup $80 $80 rectangle LOOP
|
|||
|
|
6 pat_mask !
|
|||
|
|
$10 0 DO patterns I 2* + @ pattern !
|
|||
|
|
$110 I $10 * dup >r + $110 r> - $80 $80 rectangle LOOP
|
|||
|
|
1 pat_mask ! wait ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 7 Hexblock 7
|
|||
|
|
\ kaleidoskop 20sep86we
|
|||
|
|
|
|||
|
|
| : kaleid exorwrite home center
|
|||
|
|
patterns &30 + @ pattern !
|
|||
|
|
2 0 DO
|
|||
|
|
$40 1 DO $140 0 DO I diamond J +LOOP LOOP
|
|||
|
|
LOOP ;
|
|||
|
|
|
|||
|
|
: kaleidos page big_diamond kaleid wait ;
|
|||
|
|
: kaleid1 page logo kaleid wait ;
|
|||
|
|
|
|||
|
|
: diamonds 1 pat_mask !
|
|||
|
|
$10 0 DO patterns I 2* + @ pattern !
|
|||
|
|
page big_diamond wait LOOP ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 8 Hexblock 8
|
|||
|
|
\ polygon example 18sep86we
|
|||
|
|
|
|||
|
|
| : (poly ( x y -- )
|
|||
|
|
2dup >r &100 + r> &10 +
|
|||
|
|
2dup >r &10 + r> &90 +
|
|||
|
|
2dup >r &30 - r> &20 +
|
|||
|
|
2dup >r &50 - r> &35 -
|
|||
|
|
2dup >r &30 - r> &85 - 6 polygon ;
|
|||
|
|
|
|||
|
|
: poly page
|
|||
|
|
&10 0 DO patterns I 5 + 2* + @ pattern !
|
|||
|
|
I I * &5 * I &30 * (poly LOOP
|
|||
|
|
&10 0 DO patterns I 5 + 2* + @ pattern !
|
|||
|
|
&510 I I * &5 * - I &30 * (poly LOOP
|
|||
|
|
wait ;
|
|||
|
|
|
|||
|
|
\ *** Block No. 9 Hexblock 9
|
|||
|
|
\ moire
|
|||
|
|
|
|||
|
|
: moire page curoff exorwrite titel
|
|||
|
|
&400 1 DO
|
|||
|
|
&640 0 DO I &399 &639 I - 0 line J +LOOP
|
|||
|
|
&400 0 DO &639 &398 I - 0 I line J +LOOP
|
|||
|
|
LOOP
|
|||
|
|
1 &399 DO
|
|||
|
|
&640 0 DO I &399 &639 I - 0 line J +LOOP
|
|||
|
|
&400 0 DO &639 &398 I - 0 I line J +LOOP
|
|||
|
|
-1 +LOOP wait ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 10 Hexblock A
|
|||
|
|
\ boxes 17sep86we
|
|||
|
|
|
|||
|
|
: boxes exorwrite page
|
|||
|
|
&162 0 DO I I set I dup box
|
|||
|
|
&639 I 2* - I set I dup box
|
|||
|
|
I &399 I 2* - set I dup box
|
|||
|
|
&639 I 2* - &399 I 2* - set I dup box 2 +LOOP
|
|||
|
|
wait ;
|
|||
|
|
|
|||
|
|
| Code a>r 4 SP D) D0 move D0 SP ) sub
|
|||
|
|
6 SP D) D0 move D0 2 SP D) sub Next end-code
|
|||
|
|
|
|||
|
|
: abox ( x1 y1 x2 y2 -- ) a>r 2swap set box ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 11 Hexblock B
|
|||
|
|
\ Rechtecke 17sep86we
|
|||
|
|
|
|||
|
|
: rechtecke exorwrite page
|
|||
|
|
0 BEGIN stop? not WHILE
|
|||
|
|
8 + dup >r r@ &640 mod r@ &400 mod
|
|||
|
|
&639 r@ - &640 mod &399 r> - &400 mod
|
|||
|
|
abox REPEAT drop ;
|
|||
|
|
|
|||
|
|
: rechtecke1 page exorwrite fullpattern pattern !
|
|||
|
|
BEGIN stop? not WHILE
|
|||
|
|
&99 3 DO &300 0 DO
|
|||
|
|
I dup dup J + dup a>r rectangle J +LOOP
|
|||
|
|
LOOP
|
|||
|
|
3 &98 DO &300 0 DO
|
|||
|
|
I dup dup J + dup a>r rectangle J +LOOP
|
|||
|
|
-1 +LOOP REPEAT ;
|
|||
|
|
\ *** Block No. 12 Hexblock C
|
|||
|
|
\ linien punkte 18sep86we
|
|||
|
|
|
|||
|
|
| : (lines ( abstand -- ) exorwrite
|
|||
|
|
&640 0 DO &640 0 DO I &399 J 0 line dup +LOOP
|
|||
|
|
dup +LOOP drop ;
|
|||
|
|
|
|||
|
|
: lines page home curoff &45 (lines &90 (lines
|
|||
|
|
BEGIN &45 (lines stop? UNTIL &25 0 at ;
|
|||
|
|
|
|||
|
|
: kreis_moire page &320 0 DO
|
|||
|
|
&199 0 DO I dup * J dup * + &300 / 1 and
|
|||
|
|
IF &320 J + &200 I + 1 put_pixel
|
|||
|
|
&320 J - &200 I + 1 put_pixel
|
|||
|
|
&320 J - &200 I - 1 put_pixel
|
|||
|
|
&320 J + &200 I - 1 put_pixel
|
|||
|
|
THEN 2 +LOOP LOOP wait ;
|
|||
|
|
\ *** Block No. 13 Hexblock D
|
|||
|
|
\ Sprites 20sep86we
|
|||
|
|
|
|||
|
|
\needs q : q ;
|
|||
|
|
forget q : q ;
|
|||
|
|
|
|||
|
|
: Sprite: Create 5 0 DO 4 I - roll , LOOP
|
|||
|
|
$10 0 DO $FFFF , $0F I - roll , LOOP ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
Create spritebuf &74 allot
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
-->
|
|||
|
|
\ *** Block No. 14 Hexblock E
|
|||
|
|
%0000000000000000 \ 20sep86we
|
|||
|
|
%0111111111111100
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0111111111110000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0100000000000000
|
|||
|
|
%0000000000000000 0 0 1 0 1 Sprite: test
|