Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Pascalated ZX BASIC Demo #14 - Joker
#1
To run online, click here: RUN ONLINE


Code:
' PROGRAM Joker
' (c) ZarSoft 2022 Pascalated BASIC
' (c) ZarSoft 2023 Pascalated Boriel ZX BASIC
' Written by Ze Oliveira
' Pascalated Sinclair BASIC (c) 1987 by ZarSoft
' Pascalated BASIC Converter (c) 2021 by Zarsoft
' Pascalated Boriel (c) 2023 by ZarSoft
' ZX BASIC Compiler (c) 2008 by Boriel

#include <input.bas>  ' number = VAL INPUT(12)
#include <screen.bas> ' SCREEN$ function
#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---
#define PROGRAM   REM
#define BEGIN    REM
'#define CONST     CONST
#define VAR       DIM
#define INTEGER   LONG
#define REAL      FLOAT
#define CHAR      STRING
'#define STRING    STRING
#define BOOLEAN   UBYTE
#define TYPE      AS
'#define WHILE    WHILE
#define REPEAT    DO
#define UNTIL     LOOP UNTIL
#define PROCEDURE  SUB
CONST   TRUE      TYPE BOOLEAN = 1
CONST   FALSE     TYPE BOOLEAN = 0

PROGRAM Joker

' CONSTant declarations
CONST black = 0
CONST blue = 1
CONST red = 2
CONST magenta = 3
CONST green = 4
CONST cyan = 5
CONST yellow = 6
CONST white = 7
CONST ScreenLin = 6
CONST ScreenCol = 8

' VARiable declarations
VAR S$(11) TYPE STRING ' scores 1.11
VAR SCORE TYPE INTEGER ' 0..10
VAR Year TYPE INTEGER ' current question
VAR Question$ TYPE STRING ' current question
VAR Correct TYPE INTEGER ' correct answer 1234
VAR Answer TYPE INTEGER ' user answer 1234
VAR NumQuestions TYPE INTEGER

PROCEDURE CountQuestions
PRINT AT 23,0;PAPER 7;INK blue;"Scanning database...";TAB 31;
PAUSE 50
LET NumQuestions = 0
RESTORE
READ Year
REPEAT
  READ Question$
  LET NumQuestions = NumQuestions+1
  READ Year
UNTIL Year <= 0
PRINT AT 23,0;PAPER 7; INK blue;NumQuestions;" questions detected.";TAB 32;
PAUSE 2*50
PRINT AT 23,0;PAPER 7; INK blue;"Press any key";TAB 31;
PAUSE 0: RANDOMIZE
END PROCEDURE

PROCEDURE DataQuestions
DATA 1936,"Alan Turing proposes the Turing Machine"
DATA 1945,"Construction of the ENIAC"
DATA 1947,"Invention of the first transistor"
DATA 1951,"Construction of the UNIVAC I"
DATA 1956,"IBM invents the first commercial hard drive"
DATA 1957,"IBM introduces FORTRAN, high-level computer language"
DATA 1958,"First integrated circuit is created"
DATA 1963,"The Digital Equipment Corporation introduces the minicomputer"
DATA 1963,"Invention of the first mouse"
DATA 1965,"Moore's Law is first proposed"
DATA 1968,"Founding of Intel"
DATA 1969,"Creation of UNIX"
DATA 1970,"Release of the first commercial microprocessor"
DATA 1970,"Release of Pascal structured language"
DATA 1971,"IBM releases the first commercial floppy disk"
DATA 1972,"Release of C programming language"
DATA 1975,"Founding of Microsoft"
DATA 1976,"Founding of Apple"
DATA 1976,"Release of the Electric Pencil"
DATA 1977,"Release of Apple II"
DATA 1979,"Release of the first spreadsheet computer program, VisiCalc"
DATA 1980,"Sinclair ZX80 is launched"
DATA 1981,"IBM releases its first personal computer, which ran MS-DOS"
DATA 1981,"Sinclair ZX81 is launched"
DATA 1982,"Sinclair ZX Spectrum is launched"
DATA 1983,"The CD-ROM hit the market, able to hold 550 megabytes"
DATA 1984,"Sinclair QL is launched"
DATA 1984,"QL arrives with SuperBASIC one of the first structured BASIC languages"
DATA 1984,"IBM develops a one-million bit RAM"
DATA 1984,"Launch of the first PDA"
DATA 1984,"Amstrad launches the CPC464."
DATA 1985,"Microsoft announces Windows"
DATA 1985,"Registration of the first dot-com domain"
DATA 1986,"Amstrad buys Sinclair computers"
DATA 1989,"Launch of the GRIDPad 1900, the first commercially successful tablet computer"
DATA 1990,"Invention of HTML"
DATA 1990,"Launch of the first internet browser"
DATA 1991,"Launch of the first commercial SSD"
DATA 1993,"Release of the NSCA Mosaic web browser"
DATA 1997,"Google Search launched"
DATA 1999,"Nvidia releases the GeForce 256"
DATA 1999,"Wi-Fi becomes widely used"
DATA 2003,"AMD introduces the Athlon 64, the first commercially available 64-bit processor"
DATA 2005,"Launch of YouTube"
DATA 2007,"Apple unveils the first iPhone"
DATA 2008,"Google and HTC launch HTC Dream, the first Android phone"
DATA 2012,"The Raspberry Pi, a credit-card-sized single-board computer is released"
DATA 2016,"The first reprogrammable quantum computer is created"
END PROCEDURE

PROCEDURE DataEnd
DATA -1,""
END PROCEDURE

PROCEDURE LoadKO
PAPER 0: INK 0: PRINT AT 0,0;
POKE 23739,111: REM disable messages
LOAD "KO" SCREEN$
POKE 23739,244: REM restore messages
BORDER 0
END PROCEDURE

PROCEDURE LoadOK
PAPER 0: INK 0: PRINT AT 0,0;
POKE 23739,111: REM disable messages
LOAD "OK" SCREEN$
POKE 23739,244: REM restore messages
BORDER 0
END PROCEDURE

PROCEDURE LoadQuestion
PAPER 0: INK 0: PRINT AT 0,0;
POKE 23739,111: REM disable messages
LOAD "QUESTION" SCREEN$
POKE 23739,244: REM restore messages
BORDER 0
END PROCEDURE

PROCEDURE WriteScore
FOR i=1 TO SCORE
  PRINT AT 21-i,26;PAPER blue;INK white;S$(i+1);"$";
NEXT i
END PROCEDURE

PROCEDURE finalization
PRINT PAPER blue;INK white;AT 23,0;" ";TAB 4;"That's all for today!";TAB 32;
IF SCORE >= 10
  LoadOK
  WriteScore
  PRINT AT 10,0;PAPER cyan;INK black;"         "
  PRINT AT 11,0;PAPER cyan;INK black;"YOU ARE A"
  PRINT AT 12,0;PAPER cyan;INK black;"COMPUTER \..\.."
  PRINT AT 13,0;PAPER cyan;INK black;"         "
  : FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
  PAUSE 3*50
ELSEIF SCORE >= 7
  LoadOK
  WriteScore
  PRINT AT 10,0;PAPER green;INK black;"         "
  PRINT AT 11,0;PAPER green;INK black;"CONGRATU-"
  PRINT AT 12,0;PAPER green;INK black;"LATIONS! \''\''"
  PRINT AT 13,0;PAPER green;INK black;"         "
  : FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
  PAUSE 3*50
ELSEIF SCORE >= 4
  LoadOK
  WriteScore
  PRINT AT 11,0;PAPER white;INK black;"         "
  PRINT AT 12,0;PAPER white;INK black;"Nice try!\..\.."
  PRINT AT 13,0;PAPER white;INK black;"         "
  : FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
  PAUSE 3*50
ELSEIF SCORE >= 1
  LoadKO
  WriteScore
  PRINT AT  9,0;PAPER magenta;INK black;"          "
  PRINT AT 10,0;PAPER magenta;INK black;"You should"
  PRINT AT 11,0;PAPER magenta;INK black;"upgrade   "
  PRINT AT 12,0;PAPER magenta;INK black;"your      \..\.."
  PRINT AT 13,0;PAPER magenta;INK black;"memory!   "
  PRINT AT 14,0;PAPER magenta;INK black;"          "
  : FOR i=11 TO -11 STEP -1: BEEP .01,i: BEEP .01,ABS(i): NEXT i
  PAUSE 3*50
ELSE
  LoadKO
  WriteScore
  PRINT AT 10,0;PAPER red;INK white;"         "
  PRINT AT 11,0;PAPER red;INK white;" You are "
  PRINT AT 12,0;PAPER red;INK white;" a rock! ";INK black;"\''\''"
  PRINT AT 13,0;PAPER red;INK white;"         "
  : FOR i=11 TO -11 STEP -1: BEEP .01,i: BEEP .01,ABS(i): NEXT i
  PAUSE 3*50
ENDIF
PAUSE 0
BORDER white: PAPER white: INK black: CLS
PRINT "Pascalated Boriel ZX BASIC demo"
END PROCEDURE

PROCEDURE CheckAnswer
IF Answer = Correct
  LoadOK
  LET SCORE = SCORE+1
  PRINT AT 11,0;PAPER green;INK black;"        "
  PRINT AT 12,0;PAPER green;INK black;" RIGHT! \..\.."
  PRINT AT 13,0;PAPER green;INK black;"        "
  PRINT AT 21-SCORE,26;PAPER blue;INK white;S$(SCORE+1);"$";
  WriteScore
  : FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
ELSE
  LoadKO
  PRINT AT 11,0;PAPER magenta;INK black;"        "
  PRINT AT 12,0;PAPER magenta;INK black;" WRONG! \..\.."
  PRINT AT 13,0;PAPER magenta;INK black;"        "
  PRINT AT 21-SCORE,26;PAPER blue;INK white;S$(SCORE+1);"$";
  WriteScore
  : FOR i=11 TO -11 STEP -1: BEEP .01,i: BEEP .01,ABS(i): NEXT i
ENDIF
PAUSE 1*50
REM PROC finalization: REM test final messages
END PROCEDURE

PROCEDURE InputAnswer
REPEAT
  PAUSE 0: LET k$ = INKEY$
UNTIL k$ >= "1" AND k$ <= "4"
BEEP .1,5
LET Answer = VAL k$
PRINT AT 23,(Answer-1)*8;PAPER magenta;OVER 1;"        ";
RANDOMIZE
END PROCEDURE

PROCEDURE WriteQuestion
VAR segment TYPE INTEGER
REM write question
LET segment = 10
LET k$ = Question$+"          "
LET LinStart = 12-INT(LEN Question$/segment/2+1)
FOR i=1 TO LEN Question$ STEP segment
  PRINT AT LinStart+i/segment,0;PAPER yellow;INK 0;k$(i-1 TO i+segment-1-1);
NEXT i
PRINT AT 12,segment;PAPER yellow;INK 0;"\..\..";
REM write answers
LET Correct = 1+INT(RND*4)
PRINT AT 23,0;
FOR i=1 TO 4
  PRINT " ";PAPER blue;INK white;i;"-";Year-Correct+i;PAPER black;" ";
NEXT i
END PROCEDURE

PROCEDURE SelectQuestion
RESTORE
LET NumQuestion = INT(RND*NumQuestions)
FOR i = 1 TO NumQuestion
  READ Year,Question$
NEXT i
' PRINT AT 0,0;INK 7;"resposta: ";Year
END PROCEDURE

PROCEDURE InitProgram
LET SCORE = 0
'DIM S$(11)
LET S$( 0+1)= "    0"
LET S$( 1+1)= "  100"
LET S$( 2+1)= "  250"
LET S$( 3+1)= "  500"
LET S$( 4+1)= " 1000"
LET S$( 5+1)= " 2500"
LET S$( 6+1)= " 5000"
LET S$( 7+1)= "10000"
LET S$( 8+1)= "25000"
LET S$( 9+1)= "50000"
LET S$(10+1)= "75000"
CountQuestions
:FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
BORDER 0
END PROCEDURE

PROCEDURE Game
InitProgram
FOR i=1 TO 10
  LoadQuestion
  WriteScore
  SelectQuestion
  WriteQuestion
  InputAnswer
  CheckAnswer
NEXT i
finalization
END PROCEDURE

PROGRAM Joker
PRINT
PRINT "Pascalated Boriel ZX BASIC demo"
PAUSE 1*50
BORDER 7: PAPER 7: INK 0: CLS
LOAD "SPLASH" SCREEN$
BORDER white
PAUSE 2*50
PAPER 0
Game
END PROGRAM
Reply


Messages In This Thread
Pascalated ZX BASIC Demo #14 - Joker - by zarsoft - 04-29-2023, 04:33 PM

Forum Jump:


Users browsing this thread: 2 Guest(s)