'===========================================================================
' Subject: 132-COLUMNS TEXT MODE              Date: 09-29-98 (13:22)       
'  Author: Anders Olofsson                    Code: QB, QBasic, PDS        
'  Origin: anders.olofsson@mail.bip.net     Packet: TEXT.ABC
'===========================================================================
' 132-columns, by Anders Olofsson 1998.
'                 e-mail: anders.olofsson@mail.bip.net
'
'  Here's a collection of routines needed to access and write
'  characters in the 132-columns mode. You may also use the "Getscr"
'  and "Putscr" to save screens to arrays (like get/put).
'
'  Compile it for maximum speed!

DEFINT A-Z
DECLARE SUB ResetScreen ()
DECLARE SUB Center (Row%, Text$, ForeColour%, BackColour%)
DECLARE SUB pPrint (Row%, Col%, S$, ForeColour%, BackColour%)
DECLARE SUB Set132 (Rows%)
DECLARE SUB ClearScreen ()
DECLARE SUB PutScr (Row%, Col%, Buffer%(), Scrnum%)
DECLARE SUB GetScr (Row1%, Col1%, Wid%, Hei%, Buffer%(), Scrnum%)

' Change these to suit your needs.
 COMMON SHARED ScreenWid, ScreenHei, ScreenSeg
 ScreenWid = 132: ScreenHei = 43: ScreenSeg = &HB800

 ' Buffer to store screens:
 DIM ScreenBuf(1 TO 4, (ScreenWid * ScreenHei) \ 2) AS INTEGER

 ' Set 132-columns and 43 rows.
  Set132 43
  
   Center 10, " Hello and welcome to 132 columns and 43 rows! ", 10, 1

   Center 13, "The routines in this program gives you abilities to write high-resolution text-applications,", 12, 0
   Center 14, "using 132 columns. If you're using big monitors (like 19 and 21 inches...), I know think 'll be a good surprise.", 10, 0
   Center 15, "You can save screens in buffers and put them back.", 11, 0
   Center 17, "Press a key for a 'GET SCREEN' and 'PUT SCREEN' demo.", 14, 0

  DO: LOOP UNTIL LEN(INKEY$)
 
 
 GetScr 10, 15, 105, 10, ScreenBuf(), 1
 PutScr 1, 1, ScreenBuf(), 1

RANDOMIZE TIMER * TIMER
 Row = RND * 15: Col = RND * 25: RP = 1: CP = 1

 DO
ReAdd:
  Row = Row + RP: Col = Col + CP
  IF Row + 10 > 43 THEN RP = -1: GOTO ReAdd
  IF Col + 105 > 132 THEN CP = -1: GOTO ReAdd
  IF Row < 1 THEN RP = 1: GOTO ReAdd
  IF Col < 1 THEN CP = 1: GOTO ReAdd
 
  ClearScreen
 
  PutScr Row, Col, ScreenBuf(), 1
  
   T! = TIMER: DO: LOOP UNTIL TIMER <> T!
   'FOR I = 1 TO 10
   ' WAIT &H3DA, 8: WAIT &H3DA, 8, 1: WAIT &H3DA, 8: WAIT &H3DA, 8, 1
   'NEXT
 
 LOOP UNTIL LEN(INKEY$)

 ResetScreen ' use this after to restore the screen...

SUB Center (Row, Text$, ForeColour, BackColour)
pPrint Row, (ScreenWid \ 2) - (LEN(Text$) \ 2), Text$, ForeColour, BackColour
END SUB

SUB ClearScreen
DEF SEG = ScreenSeg
FOR I = 0 TO ScreenHei * ScreenWid * 2
 POKE I, 0
NEXT
END SUB

SUB GetScr (Row1, Col1, Wid, Hei, Buffer%(), Scrnum)
DEF SEG = ScreenSeg
Buffer%(Scrnum, 0) = 256 * Wid + Hei
FOR R = Row1 TO Row1 + Hei - 1
FOR C = Col1 TO Col1 + Wid - 1
  Chrcode = PEEK(((R - 1) * ScreenWid + C - 1) * 2)
  ColrCode = PEEK(((R - 1) * ScreenWid + C - 1) * 2 + 1)
  Counter = Counter + 1
  Buffer%(Scrnum, Counter) = -32768 + 256& * ColrCode + Chrcode
NEXT
NEXT
END SUB

SUB pPrint (Row, Col, S$, ForeColour, BackColour)
IF Row > ScreenHei OR Row < 1 OR Col > ScreenWid OR Col < 1 THEN EXIT SUB
DEF SEG = ScreenSeg: Memloc = ScreenWid * (Row - 1) + (Col - 1): Memloc = Memloc + Memloc
FOR T = 0 TO LEN(S$) - 1
 IF Col + T > ScreenWid THEN EXIT FOR
 POKE Memloc, ASC(MID$(S$, T + 1, 1))
 POKE Memloc + 1, BackColour * 16 + ForeColour
 Memloc = Memloc + 2
NEXT T
DEF SEG
END SUB

SUB PutScr (Row, Col, Buffer%(), Scrnum)
Wid = Buffer%(Scrnum, 0) \ 256: Hei = Buffer%(Scrnum, 0) MOD 128
DEF SEG = ScreenSeg
FOR R = Row TO Row + Hei - 1
FOR C = Col TO Col + Wid - 1
  Counter = Counter + 1
  IF C <= ScreenWid AND C >= 1 THEN
   Chrcode = Buffer(Scrnum, Counter) MOD 256
   ColrCode = (Buffer(Scrnum, Counter) + 32768) \ 256
   POKE (((R - 1) * ScreenWid + C - 1) * 2), Chrcode
   POKE (((R - 1) * ScreenWid + C - 1) * 2) + 1, ColrCode
  END IF
NEXT
NEXT
END SUB

SUB ResetScreen
asm$ = CHR$(&HB8) + CHR$(3) + CHR$(0)
asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) + CHR$(&HCB)
DEF SEG = VARSEG(asm$): CALL absolute(SADD(asm$))
END SUB

SUB Set132 (Rows)
IF Rows = 43 THEN Vidmode = &H54
IF Rows = 25 THEN Vidmode = &H55
IF Vidmode = 0 THEN EXIT SUB
asm$ = asm$ + CHR$(&HB8) + CHR$(Vidmode) + CHR$(0)
asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) + CHR$(&HCB)
DEF SEG = VARSEG(asm$): CALL absolute(SADD(asm$))
END SUB