Metropoli BBS
VIEWER: cdot.s MODE: TEXT (ASCII)
%%HP: T(3)A(D)F(.);
"xROMID 815
xTITLE CDOT v1.0 ostcroix@aol.com
xCONFIG Ccfg

EXTERNAL xCDOT
EXTERNAL PLO
EXTERNAL SCALA

 
DEFINE  Sgrob      5GETLAM 
DEFINE  Pkno       4GETLAM 
DEFINE  exit?      3GETLAM 
DEFINE  arr        2GETLAM 
DEFINE  size       1GETLAM

DEFINE  !Sgrob     5PUTLAM
DEFINE  !Pkno      4PUTLAM
DEFINE  !exit?     3PUTLAM


DEFINE  kpNoShift    ONE
DEFINE  kcNegate     TWENTYSIX
DEFINE  kcEnter      TWENTYFIVE
DEFINE  kcLeftArrow  SIXTEEN
DEFINE  kcRightArrow EIGHTEEN
DEFINE  kcRightShift FORTY
DEFINE  kpRightShift THREE
DEFINE  kcOn         FORTYFIVE

LABEL Ccfg
:: 815 TOSRRP ;

NIBB 1 8
xNAME CDOT
    ::
CK&DISPATCH1
FOUR
::    
DUP
DIMLIMITS
INNER#1=
caseDROP

#1= NOTcaseDROP 
 DROP
   POLSaveUI
   ERRSET
      ::
        RECLAIMDISP
        TURNMENUOFF
        SIXTYTHREE
        ONE 3PICKSWAP
        PTR 49569
     
******** Set plot range *********
    SWAP2DUP
    %-
    % .15
    %*
    %-
    SWAP
    %>%%SWAP 
    %>%%     
    OVERSWAP 
    %%-      
    ROT      
    UNCOERCE%%
    SWAP2DUP 
    %%/      
    4UNROLL  
    3UNROLL
    %%*SWAP
    %%/    


   ZERO FALSE
   FALSE 6ROLL DUP ARSIZE
DUP  SIXTY #> IT
:: DROP SIXTY ;

 { NULLLAM  NULLLAM  NULLLAM 
   NULLLAM  NULLLAM  }  
   BIND

*** Resize ABUFF for arr size ***
        ZEROZERO
        #64
        SCALA
        size
        NTHCOMPDROP
        DUP
        !Pkno
        #84
        #<ITE
        #83
      :: Pkno #8+ ;
       !Pkno 
       Pkno
       MAKEGROB
       XYGROBDISP

*** plot numbers in menu area **
       DOSTD
       size
       #1+
       FIVE
       DO
       INDEX@
       UNCOERCE
       editdecomp$w
       $>grob
       ABUFF
       SCALA
       INDEX@
       NTHCOMPDROP
       # 3B
       GROB!
       INDEX@
       #4+
       INDEXSTO
       LOOP
       FOUR DOFIX
******** plot pixels *********


SCALA      
arr
size
#1+_ONE_DO 
INDEX@      ( list array # )
PULLREALEL  ( list array % )
4PICK 6PICK ( list array % Rcon2 Rcon1 )
getypos     ( list array # #y1 )
SWAPDROP    ( list array #y1 )
3PICK       ( list array #y1 list )
INDEX@      ( list array #y1 list # )
NTHCOMPDROP ( list array #y1 #x1 )
#2+         ( list array #y1 #x1 )
SWAP
PIXON
LOOP
2DROP
ABUFF TOTEMPOB !Sgrob 


***** Toggel lines on dots *****
 PLO



   'NOP



   ' ::
        kpNoShift #=casedrop
         ::

        kcNegate ?CaseKeyDef
             :: TakeOver

 EIGHT UserITE 
 ::  Sgrob ABUFF ZEROZERO GROB!
     EIGHT ClrUserFlag  ;
 
     PLO ;

 kcLeftArrow ?CaseKeyDef
 :: TakeOver
    LEFTCOL #0= caseDoBadKey
#83 ONE_DO WINDOWLEFT LOOP ;

kcRightArrow ?CaseKeyDef
  :: TakeOver Pkno RIGHTCOL
 #1+ #= caseDoBadKey

#83 ONE_DO WINDOWRIGHT LOOP ;

kcEnter ?CaseKeyDef

:: TakeOver TRUE  !exit? 
   2DROP ABUFF TOTEMPOB  ;


kcOn ?CaseKeyDef
:: TakeOver TRUE !exit? 2DROP ;

kcRightShift #=casedrpfls DROP
 'DoBadKeyT ;

 kpRightShift #=casedrop
 :: kcOn ?CaseKeyDef
 :: TakeOver TurnOffKey  ;


 kcRightShift #=casedrpfls DROP
 'DoBadKeyT  ;

  2DROP 'DoBadKeyT ;
        TrueTrue            
        NULL{}
        ONEFALSE'
         exit?  
        'ERRJMP  
        POLSetUI 
        POLKeyUI
        ABND
        TURNMENUON    
        RECLAIMDISP
        ClrDAsOK  ;
        ERRTRAP
 :: TURNMENUON RECLAIMDISP
    ClrDAsOK FOUR DOFIX
    POLResUI&Err ;
  POLRestoreUI ; ;    


NULLNAME PLO
   ::

THREE            
 arr        
ONE              
PULLREALEL       
SWAPDROP         
3PICK 5PICK      
getypos          
SWAPDROP         
 size
#1+_ONE_DO 
 SCALA
INDEX@
NTHCOMPDROP
#2+
 arr 
INDEX@   
PULLREALEL
SWAPDROP  
5PICK 7PICK
getypos    
SWAPDROP   
2DUP       
6UNROLL    
6UNROLL    
LINEON     
LOOP
2DROP
EIGHT SetUserFlag ;


NULLNAME SCALA
{
 # 1
 # 4
 # 8
 # C
 # 10
 # 14
 # 18
 # 1C
 # 20
 # 24
 # 2C
 # 34
 # 3C
 # 44
 # 4C
 # 54
 # 5C
 # 64
 # 6C
 # 74
 # 7C
 # 84
 # 8C
 # 94
 # 9C
 # A4
 # AC
 # B4
 # BC
 # C4
 # CC
 # D4
 # DC
 # E4
 # EC
 # F4
 # FC
 # 104
 # 10C
 # 114
 # 11C
 # 124
 # 12C
 # 134
 # 13C
 # 144
 # 14C
 # 154
 # 15C
 # 164
 # 16C
 # 174
 # 17C
 # 184
 # 18C
 # 194
 # 19C
 # 1A4
 # 1AC
 # 1B4
}"
[ RETURN TO DIRECTORY ]