¡¡ € ¡¡       P r o g r a m    8 0 3 2       ¡¡ € ¡¡
Frank's Humble Abode at frankosite2020.com .... formerly known as frankosport.com
Written for PowerBasic DOS Version 3.50 (original conception, 1990's / last updated 2025)

Creates a visual and aural emulation of the Commodore Basic 4.0 power-on screen - plus a surprise!

Commodore Basic 4.0

Download compiled 8032.EXE program, stored in ZIP file 8032-Demo.zip. Once extracted,
it can be viewed using a DOS emulator such as Dosbox -OR- DosBox-X.  

Complete code shown below

frankosite2020.com »»»   Home Page       About Me       E-Mail       Sign My GuestBook

See Also »»»   Kube-0-Seven   PowerBasic Console Compiler Demonstration Program

Visit »»»   "PUMP"   PowerBASIC Users Meeting Place -- New Alternative Discussion Site


' ==========================================================

 $Compile exe "8032.EXE"
 $CPU 80386

 REM  The question mark ? is used in place of PRINT
      (old BASIC command shortcut)

 SSTART:
 screen 0
 width 40:cls
 ? AT0(2,1);""
 Sleep .75

 JDQ=1
 JDZ=0
 DO
   INCR JDZ, 1
   Sound 1334,1
   Sound 1068,1
   Sound 1334,1
   Sound 1000,1
 LOOP Until (JDZ=7)
 sleep 1

 Color 10
 ? "*** Commodore Basic 4.0 ***"
 ? " 31743 Bytes Free"
 ? "Ready."

 color 26
 ? CHR$(219)
 ?
 sleep 5
 Call PET2001
 Color 15,0
 ?: ? "Press S (Repeat) or X (Exit)"

 KKode=1
 LLoopx:
 QX$=Inkey$
 IF UCASE$(QX$)="S" THEN KKode=3
 IF UCASE$(QX$)="X" THEN KKode=5
 IF KKode=1 THEN GOTO LLoopx
 IF KKode=3 THEN GOTO SStart

 IF KKode=5 Then
    CLS
    Color 7: ?: ?: ? "END"
 END IF

 END

' ===========================================================
 FUNCTION AT0(BYVAL row AS LONG, BYVAL col AS LONG) AS STRING
   LOCATE row, col, 0:' cursor invisible
 END FUNCTION

' ===========================================================
 SUB PET2001

 REM  The question mark ? is used in place of PRINT
      (old BASIC command shortcut)

 DIM Xsee (140)
 DIM XHear(13)

 XHear(1)=1250
 XHear(2)=1790
 XHear(3)=1358
 XHear(4)=1898
 XHear(5)=1466
 XHear(6)=2006
 XHear(7)=1574
 XHear(8)=2114
 XHear(9)=1682

 ? AT0(10,1);"";

 Restore DeeColors

 JDF=99
 JDT=0

 DO
   INCR JDT, 1
   Read Xsee(JDT)
   IF Xsee(JDT)=99 THEN JDF=88
   IF JDT=128 THEN JDF=88
 Loop Until (JDT=128 or JDF=88)

 JDS=0
 DO
   JPJ$="!"
   INCR JDS,1
   IF JDS=129 THEN Exit Loop

   NXAA=1+(JDS MOD 9)
   ' JDS MOD 9 results in values of 0, 1, 2, 3, 4, 5, 6, 7 or 8

   Sound Xhear(NXAA),1.75
   Color Xsee(JDS)
   Putt$=CHR$(2)

   Select Case JDS
     Case 7,17,26,38,41,56,63,71,81,90,98,105,114
          Putt$=CHR$(1)
   End Select
   ? Putt$;" ";
   sleep .09

   JPJ$=Inkey$
   IF JPJ$=CHR$(0,63) THEN JDS=99:' F-Key 5 is CHR$(0,63)
 LOOP UNTIL (JDS>=128)
 ?
 IF JDS<128 THEN Delay 2.00

 DeeColors:
   data 15,11,12,10,06,14,21,15,13,04,02,11,14,03,10,06
   data 00,14,18,12,09,06,14,05,08,13,04,15,01,12,26,02
   data 14,05,15,13,04,02,11,14,07,10,10,07,15,14,02,12
   data 09,02,11,14,03,15,06,15,00,02,12,25,12,01,14,11
   data 15,11,12,10,06,14,21,15,13,04,02,11,14,03,10,04
   data 00,14,18,12,09,06,14,05,08,13,04,15,01,12,26,06
   data 07,13,11,23,04,11,19,19,00,02,28,09,01,14,22,03
   data 10,10,25,00,00,14,06,13,24,01,09,12,29,12,08,04
   data 99,99,99,99,99,99

 END SUB

' ===========================================================

Frank's Humble Abode at frankosite2020.com .... formerly known as frankosport.com
¡¡ € ¡¡       P r o g r a m    8 0 3 2       ¡¡ € ¡¡

Written for PowerBasic DOS Version 3.50 (original conception, 1990's / last updated 2025)

Creates a visual and aural emulation of the Commodore Basic 4.0 power-on screen - plus a surprise!

Commodore Basic 4.0

Download compiled 8032.EXE program, stored in ZIP file 8032-Demo.zip. Once extracted,
it can be viewed using a DOS emulator such as Dosbox -OR- DosBox-X.  

Complete code shown above

frankosite2020.com »»»   Home Page       About Me       E-Mail       Sign My GuestBook

See Also »»»   Kube-0-Seven   PowerBasic Console Compiler Demonstration Program

Visit »»»   "PUMP"   PowerBASIC Users Meeting Place -- New Alternative Discussion Site


Go Back to the Top of This Page