(* Alhambra & cirkel

Voor 16 bits tegel/cirkel enkele getallen aanpassen

*)

hex
\ Kleur: 44 = donker blauw, 46 = donker cyaan, 47 = grijs,
\ 104 = paars blauw 106 = cyaan, 107 = helder wit, 0 = standaard kleur
: COLOR     ( +n -- )
    hor >r  dm 27 emit  ch [ emit   \ CSI
    base @ hex  swap  0 .r  base !  \ ASCII waarden van SGR parameters
    ch m emit  r> to hor ;          \ Sluit & corrigeer HOR

: ZW    0 color ;   : DB    44 color ;
: PAGE  dm 27 EMIT ." [H" dm 27 EMIT ." [2J" ;


\ Random
0 value RND  23 to rnd                  \ any number allowed as seed
: KIES      ( -- +n )                   \ +n = 0 to FF
    rnd dm 31421 *  dm 6927 +  
    FFFF and  dup to rnd  6 rshift ;    \ 16bits: 8 RSHIFT for W = 10


20 constant W   \ 16bits: 16x16 tegel, W=10
05 constant S   \ 16bits: 16x16 tegel, S=4
create TEGEL  W dup * allot  align
: WBITS     ( x1 -- x2 )    W 1- and ;
: NEGW      ( x -- -x )     negate WBITS ;
: WIS       ( -- )          TEGEL W W * 0 fill ;
: INIT      ( +n -- )       to rnd  wis ;

: >XY       ( +n -- h v )   dup WBITS  swap S rshift WBITS ;
: >POS      ( h v -- a )    S lshift or  TEGEL + ;
: PLOT      ( h v -- )      >pos  FF swap c! ;

\ Plot varianten
: PLOT+     ( h v -- )      \ Spiegel horizontaal & verticaal
    2dup plot   2dup NEGW plot
    >r NEGW r>  2dup plot   NEGW plot ;

: PLOTx     ( h v -- )      \ Spiegel diagonaal
    2dup plot   swap 2dup plot
    NEGW swap NEGW   2dup plot  swap plot ;

: PLOT*     ( h v )     2dup plot+  swap plot+ ;


\ Afbeelden
dm 10 value PART            \ Percentage gebruikte tegeltjes
2  value RIJ                \ Tegels op een rij
2  value KOLOM              \ Tegels onder elkaar
: %     64 umin to PART ;   \ Zet percentage
: >PAT  4 umin to kolom     \ Zet af te beelden aantal tegels
        9 umin to rij ;

: .P        ( h v -- )      \ Toon tegelwandje
    >pat  page              \ Zet formaat
    kolom for               \ Aantal vertikale tegels
        W W * 0 do            \ Een tegel rij
            cr  0  begin    \ Print tegels naast elkaar
                db  TEGEL i +           \ Bereken tegel rij
                W bounds do             \ Print RIJ maal een regel
                    bl  i c@ bl and  +  \ Maak karakter
                    emit  space         \ Druk af
                loop
            1+ dup RIJ = until          \ Rij klaar?
            drop  zw space              \ Rond af
        W +loop             \ Volgende regel van tegel
    next ;                  \ Volgende RIJ tegels

: P         ( -- )      1 1 .p ;
: >PERC     ( +n v -- ) swap init  part swap dm 100 */ ;
: P+        ( nr -- )   dm 288 >perc  for  kies >xy plot+  next ; \ 16bits: 88
: Px        ( nr -- )   dm 272 >perc  for  kies >xy plotx  next ; \ 16bits: 73
: P*        ( nr -- )   dm 152 >perc  for  kies >xy plot*  next ; \ 16bits: 45

dm 2000 value WACHT  3 value H  2 value V
: DEMO      ( name -- )
    ' >r  1  begin  dup r@ execute  h v .p  wacht ms 1+  stop? until  r> 2drop ;
decimal


(* Nu de Cirkel met 45 graden pukkel correctie

  x b 
  a c   c 2
        1 3

*)

0 value R       \ Straal
0 value ^R      \ Straal kwadraat
0 value X       \ Horizontale positie
0 value Y       \ Verticale positie
0 value O       \ Offset

: DIFF  ( -- diff )     X X *  Y Y * +  ^R -  abs ; \ Bepaal verschil

: CK        ( straal -- )
    wis  to R   R R * to ^R                     \ Wis tabel
    0 to X  R to Y  W 2/ R - to O               \ Init. parameters
    begin
        R X - O +  R Y - O + plot+              \ Plot een dot
    Y while                                     \ Y niet nul?
        -1 +to Y  diff                          \ Ja, lees Y-1
        incr X  1 +to Y  diff                   \ Lees X+1
        2dup > if                               \ Y>X
            nip                                 \ drop Y
            -1 +to Y  diff <                    \ Lees Y-1 & X+1, X<
            if  X Y 1+ <> if incr Y  then  then \ Ja, doe X met pukkel correctie
                                                \ Niet, behoud Y-1 en X+1
        else                                    \ Y<=X
            drop                                \ drop X
            -1 +to Y  diff <                    \ Y<
            if  -1 +to X  then                  \ Doe Y
        then
    repeat ;

\ End ;;;