TIP: Click on subject to list as thread! ANSI
echo: quik_bas
to: ALL
from: DAVID WILLIAMS
date: 2003-01-05 20:42:46
subject: something to play with

----------------------------------------------------- 
  
' ROTATE.BAS 
' David Williams, 2001 etc. 
' david.williams{at}ablelink.org 
' This version dated 2003 Jan 04 
' Program demonstrates a routine that rotates graphic SCREEN 11 
' image by 90 degrees. 
  
DECLARE SUB Secpause () 
DECLARE SUB Twist (DI%) 
  
DEFINT A-Z 
  
CLS 
PRINT "Rotate lockwise or nticlockwise? "; 
DO 
  D$ = UCASE$(INKEY$) 
LOOP UNTIL D$ = "C" OR D$ = "A" 
PRINT D$ 
DI = (D$ = "C") 
  
CALL Secpause 
  
SCREEN 11 
  
' draw demo diagram 
CLS 
CIRCLE (320, 240), 200 
LINE (200, 200)-(250, 200) 
CIRCLE (420, 200), 20 
CIRCLE (420, 200), 3 
LINE (320, 220)-(320, 260) 
LINE (200, 300)-(320, 350) 
LINE (320, 350)-(440, 300) 
LOCATE 1, 38 
PRINT "SMILE!"; 
LOCATE 30, 30 
PRINT "Press any key to quit"; 
  
CALL Secpause 
  
DO WHILE INKEY$  "" 
LOOP 
  
DO 
  CALL Twist(DI) 
  IF INKEY$  "" THEN EXIT DO 
  CALL Secpause 
LOOP 
  
END 
  
SUB Secpause 
  T! = TIMER 
  DO 
    IF TIMER < T! THEN T! = T! - 86400 
  LOOP UNTIL TIMER >= T! + 1 
END SUB 
  
SUB Twist (DI) 
  
  D = SGN(DI + .5) 
  
  DIM A(0 TO 7, 10 TO 69), V(0 TO 7), W(0 TO 7) 
  
  V(7) = 1 
  FOR X = 7 TO 1 STEP -1 
    V(X - 1) = V(X) + V(X) 
  NEXT 
  
  IF D = 1 THEN 
    U& = 38330 
    FOR X = 0 TO 7 
      W(X) = V(X) 
    NEXT 
  ELSE 
    U& = 69 
    FOR X = 0 TO 7 
      W(X) = V(7 - X) 
    NEXT 
  END IF 
  
  S1 = 80 * D 
  S2 = 8 * S1 
  S3& = 38401 * D 
  
  DEF SEG = &HA000 
  
  F$ = "TTWSII.BP1" 
  
  BSAVE F$, 0, 38400 
  
  CLS 
  
  LINE (79, 0)-(79, 479)    ') These lines, plus top and bottom of 
  LINE (561, 0)-(561, 479)  ') screen, outline square that is rotated 
  
  F% = FREEFILE 
  OPEN F$ FOR BINARY AS F% 
  
  N$ = STRING$(60, 0) 
  
  J$ = INPUT$(7, F%)   ' dump 1st 7 bytes from file 
  
  FOR S = 0 TO 59  ' 60 stripes, each 8 rows deep 
    L$ = INPUT$(640, F%) 
    FL = 0 
    FOR X = 0 TO 7 
      IF MID$(L$, 80 * X + 11, 60)  N$ THEN FL = 1: EXIT FOR 
    NEXT 
    IF FL THEN 
      B = 11 
      FOR R = 0 TO 7             ' read 8 rows into array 
        FOR C = 10 TO 69 
          A(R, C) = ASC(MID$(L$, B, 1)) 
          B = B + 1 
        NEXT 
        B = B + 20 
      NEXT 
      FOR C = 10 TO 69 ' 0 - 9 and 70 - 79 not printed 
        X = 0 
        FOR R = 0 TO 7 
          IF A(R, C) THEN X = 1: EXIT FOR 
        NEXT 
        IF X THEN 
          FOR Y = 0 TO 7    ' analyse 8 bits per byte 
            B = 0 
            FOR R = 0 TO 7 
              IF A(R, C) AND V(Y) THEN B = B OR W(R) 
            NEXT 
            POKE U&, B 
            U& = U& - S1 
          NEXT Y 
        ELSE 
          U& = U& - S2 
        END IF 
      NEXT C 
      U& = U& + S3& 
    ELSE 
      U& = U& + D 
    END IF 
  NEXT S 
  
  DEF SEG 
  
  CLOSE F% 
  
  KILL F$ 
  
END SUB 
  
--------------------------------------------------------- 
* Origin: The Bayman BBS,Toronto, (416)698-6573 - 1:250/514 (1:250/514)
SEEN-BY: 633/267 270
@PATH: 250/514 140/1 106/2000 1 379/1 633/267

SOURCE: echomail via fidonet.ozzmosis.com

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.