home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pctech
/
1986_08
/
glabel.bas
< prev
next >
Wrap
BASIC Source File
|
1986-04-23
|
4KB
|
108 lines
10 SCREEN 2:KEY OFF:CLS
20 REM
30 REM DEMONSTRATE VERTICAL RESOLUTION
40 REM
50 X=0
60 FOR Y = 7 TO 20
70 L$=CHR$(Y+58)
80 GOSUB 400
90 X=X+8
100 NEXT Y
110 REM
120 REM DEMONSTRATE HORIZONTAL RESOLUTION
130 REM
140 Y = 60
150 FOR X = 65 TO 75
160 L$=CHR$(X):GOSUB 400
170 Y = Y + 8
180 NEXT X
190 REM
200 REM DEMONSTRATE LARGE LETTERS
210 REM
220 Y=80
230 A$="BIG LETTERS"
240 FOR I = 1 TO LEN(A$)
250 X = 150+I*16
260 L$=MID$(A$,I,1)
270 GOSUB 690
280 NEXT I
290 REM
300 REM DEMONSTRATE 90 DEGREE ROTATION
310 REM
320 A$="90 DEGREE ROTATION"
330 X = 400
340 FOR I = 1 TO LEN(A$)
350 Y = 200-I*8
360 L$=MID$(A$,I,1)
370 GOSUB 870
380 NEXT I
390 LOCATE 20,1:STOP
400 REM
410 REM SUBROUTINE PRINTS A LETTER L$ WHOSE LOWER LEFT-HAND CORNER
420 REM WILL BE LOCATED AT (X,Y).
430 REM
440 IF ASC(L$) > 127 THEN RETURN
450 XX = X MOD 640:IF XX < 0 THEN XX = XX + 640 'MAKE 0 <= XX <= 639
460 REM
470 REM UNLESS (X MOD 8) = 0, PARTS OF THE LETTER WILL BE IN TWO
480 REM DIFFERENT COLUMNS.
490 REM
500 SHIFT = 2^(8-(XX MOD 8)) 'USED TO SHIFT BITS
510 LL = INT(XX/8) '1ST COLUMN
520 NN = (LL+1) MOD 80 '2ND COLUMN
530 FOR II=Y-7 TO Y 'ROW LOOP
540 YY = II MOD 200:IF YY < 0 THEN YY = YY + 200 'MAKE 0 <= YY <= 100
550 DEF SEG = &HF000 'SEGMENT OF ROM
560 REM
570 REM GET A BYTE REPRESENTING ONE OF THE EIGHT ROWS OF DOTS THAT
580 REM MAKE UP THE CHARACTER. SHIFT THE VALUE SO THAT THE BITS
590 REM THAT GO IN THE TWO COLUMNS ARE SEPARATED INTO SEPARATE BYTES
600 REM
610 KK = PEEK(&HFA6E+ASC(L$)*8+II-Y+7)*SHIFT
620 DEF SEG = &HB800 'SEGMENT FOR VIDEO
625 REM OFFSET FOR EVEN/ODD ROWS:
630 IF YY MOD 2 = 0 THEN DISP=0 ELSE DISP = &H2000
640 MM = INT(YY/2)*80 'OFFSET TO ROW
645 REM SET BITS IN 1ST COLUMN:
650 POKE DISP+MM+LL,PEEK(DISP+MM+LL) OR INT(KK/256)
655 REM SET BITS IN 2ND COLUMN:
660 POKE DISP+MM+NN,PEEK(DISP+MM+NN) OR (KK-INT(KK/256)*256)
670 NEXT II
680 RETURN
690 REM
700 REM SUBROUTINE PRINTS A DOUBLE-WIDTH CHARACTER L$ WHOSE LOWER
710 REM LEFT-HAND CORNER IS (X,Y)
720 REM
730 IF ASC(L$) > 127 THEN RETURN
740 DEF SEG =&HF000 'SEGMENT OF ROM
750 FOR II = Y-7 TO Y 'ROW LOOP
760 XX = X MOD 640:IF XX < 0 THEN XX = XX + 640 'MAKE 0<= XX <= 639
770 YY = II MOD 200:IF YY < 0 THEN YY=YY+200 'MAKE 0<= YY <= 199
780 KK = PEEK(&HFA6E+ASC(L$)*8+II-Y+7) 'GET PATTERN FOR A ROW
790 FOR LL=1 TO 8 'LOOK AT BITS IN THE PATTERN
800 MM = KK MOD 2 'GET LAST BIT
810 NN=XX+16-2*LL
815 REM MAKE 2 DOTS
820 IF MM <> 0 THEN PSET(NN MOD 640,YY):PSET((NN+1) MOD 640,YY)
830 KK = INT(KK/2) 'SHIFT BITS RIGHT
840 NEXT LL
850 NEXT II
860 RETURN
870 REM
880 REM SUBROUTINE PRINTS A CHARACTER L$ WHICH HAS BEEN ROTATED
890 REM 90 DEGREES AROUND ITS LOWER LEFT-HAND CORNER (X,Y).
900 REM
910 IF ASC(L$) > 127 THEN RETURN
920 DEF SEG =&HF000 'ROMS SEGMENT
930 FOR II = 1 TO 8 'ROW LOOP
940 KK = PEEK(&HFA6E+ASC(L$)*8+II-1) 'GET PATTERN FOR A ROW
950 FOR LL=1 TO 8 'COLUMN LOOP
960 MM = KK MOD 2 'GET LAST BIT
970 NN=(X-16+2*II-1) MOD 640:IF NN < 0 THEN NN=NN+640 'GET X COOR.
980 YY = (Y-8+LL) MOD 200:IF YY < 0 THEN YY = YY + 200 'GET Y COOR.
990 IF MM <> 0 THEN PSET(NN,YY):PSET(NN+1,YY) 'MAKE TWO DOTS
1000 KK = INT(KK/2) 'SHIFT BITS RIGHT
1010 NEXT LL
1020 NEXT II
1030 RETURN