home *** CD-ROM | disk | FTP | other *** search
- program Sm;
- uses crt, dos, Graph, sounds;
- const
- { The five fonts available }
- Fonts : array[0..4] of string[13] =
- ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
-
- { The five predefined line styles supported }
- LineStyles : array[0..4] of string[9] =
- ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
-
- { The twelve predefined fill styles supported }
- FillStyles : array[0..11] of string[14] =
- ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
- 'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
- 'InterleaveFill', 'WideDotFill', 'CloseDotFill');
-
- { The two text directions available }
- TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
-
- { The Horizontal text justifications available }
- HorizJust : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
-
- { The vertical text justifications available }
- VertJust : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
-
- var
- X,Y,Width,Height,OrigMode,LastCol,LastRow: Word;
- Ch: Char;
- Viewinfo : ViewPortType;
- GraphDriver : integer; { The Graphics device driver }
- GraphMode : integer; { The Graphics mode value }
- MaxX, MaxY : word; { The maximum resolution of the screen }
- ErrorCode : integer; { Reports any graphics errors }
- MaxColor : word; { The maximum color value available }
- OldExitProc : Pointer; { Saves exit procedure address }
- procedure LITTfont; external; {$L LITT.OBJ }
- procedure SANSfont; external; {$L SANS.OBJ }
- procedure TRIPfont; external; {$L TRIP.OBJ }
- procedure HercDriver; external; {$L HERC.OBJ }
- procedure EGAVGADriver; external; {$L EGAVGA.OBJ }
- procedure IBM8514Driver; external; {$L IBM8514.OBJ }
- procedure Loadthefont( ProcedurePointer : pointer );
- begin
- if RegisterBGIfont( ProcedurePointer ) < 0 then begin
- writeln('Error registering font :', graphErrorMsg( Graphresult ) );
- Halt( 1 );
- end;
- end;
- procedure PrepareTheFonts;
- begin
- Loadthefont( @LITTfont );
- Loadthefont( @SANSfont );
- Loadthefont( @TRIPfont );
- end;
- procedure LoadtheDriver( ProcedurePointer : pointer );
- begin
- if RegisterBGIdriver( ProcedurePointer ) < 0 then begin
- writeln('Error registering driver :', graphErrorMsg( Graphresult ) );
- Halt( 1 );
- end;
- end;
- procedure PrepareTheDrivers;
- begin
- Loadthedriver( @EGAVGAdriver );
- Loadthedriver( @HERCdriver );
- Loadthedriver( @IBM8514driver );
- end;
-
- {$F+}
- procedure MyExitProc;
- begin
- ExitProc := OldExitProc; { Restore exit procedure address }
- CloseGraph; { Shut down the graphics system }
- end; { MyExitProc }
- {$F-}
-
- procedure Initialize;
- { Initialize graphics and report any errors that may occur }
- var
- InGraphicsMode : boolean; { Flags initialization of graphics mode }
- PathToDriver : string; { Stores the DOS path to *.BGI & *.CHR }
- begin
- { when using Crt and graphics, turn off Crt's memory-mapped writes }
- DirectVideo := False;
- OldExitProc := ExitProc; { save previous exit proc }
- ExitProc := @MyExitProc; { insert our exit proc in chain }
- repeat
-
- {$IFDEF Use8514} { check for Use8514 $DEFINE }
- GraphDriver := IBM8514;
- GraphMode := IBM8514Hi;
- {$ELSE}
- GraphDriver := Detect; { use autodetection }
- {$ENDIF}
-
- InitGraph(GraphDriver, GraphMode, '');
- ErrorCode := GraphResult; { preserve error return }
- if ErrorCode <> grOK then { error? }
- begin
- Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
- if ErrorCode = grFileNotFound then { Can't find driver file }
- begin
- Writeln(' !!!!!!!!!! Note !!!!!!!!!');
- Writeln(' You must have EGA or VGA graphics card plus a color display.');
- Writeln(' type <Ctrl-Break> to quit:');
- Writeln;
- end
- else
- Halt(1); { Some other error: terminate }
- end;
- until ErrorCode = grOK;
- Randomize; { init random number generator }
- MaxColor := GetMaxColor; { Get the maximum allowable drawing color }
- MaxX := GetMaxX; { Get screen resolution values }
- MaxY := GetMaxY;
- end; { Initialize }
-
- function Int2Str(L : LongInt) : string;
- { Converts an integer to a string for use with OutText, OutTextXY }
- var
- S : string;
- begin
- Str(L, S);
- Int2Str := S;
- end; { Int2Str }
-
- function RandColor : word;
- { Returns a Random non-zero color value that is within the legal
- color range for the selected device driver and graphics mode.
- MaxColor is set to GetMaxColor by Initialize }
- begin
- RandColor := Random(MaxColor)+1;
- end; { RandColor }
-
- procedure DefaultColors;
- { Select the maximum color in the Palette for the drawing color }
- begin
- SetColor(MaxColor);
- end; { DefaultColors }
-
- procedure DrawBorder;
- { Draw a border around the current view port }
- var
- ViewPort : ViewPortType;
- begin
- DefaultColors;
- SetLineStyle(SolidLn, 0, NormWidth);
- GetViewSettings(ViewPort);
- with ViewPort do
- Rectangle(0, 0, x2-x1, y2-y1);
- end; { DrawBorder }
-
- procedure FullPort;
- { Set the view port to the entire screen }
- begin
- SetViewPort(0, 0, MaxX, MaxY, ClipOn);
- end; { FullPort }
-
- procedure MainWindow(Header : string);
- { Make a default window and view port for demos }
- begin
- DefaultColors; { Reset the colors }
- ClearDevice; { Clear the screen }
- SetTextStyle(DefaultFont, HorizDir, 1); { Default text font }
- SetTextJustify(CenterText, TopText); { Left justify text }
- FullPort; { Full screen view port }
- OutTextXY(MaxX div 2, 2, Header); { Draw the header }
- { Draw main window }
- SetViewPort(0, TextHeight('M')+4, MaxX, MaxY-(TextHeight('M')+4), ClipOn);
- DrawBorder; { Put a border around it }
- { Move the edges in 1 pixel on all sides so border isn't in the view port }
- SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
- end; { MainWindow }
-
- procedure StatusLine(Msg : string);
- { Display a status line at the bottom of the screen }
- begin
- FullPort;
- DefaultColors;
- SetTextStyle(DefaultFont, HorizDir, 1);
- SetTextJustify(CenterText, TopText);
- SetLineStyle(SolidLn, 0, NormWidth);
- SetFillStyle(EmptyFill, 0);
- Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY); { Erase old status line }
- Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
- OutTextXY(MaxX div 2, MaxY-(TextHeight('M')+2), Msg);
- { Go back to the main window }
- SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
- end; { StatusLine }
-
- procedure color2;
- { give introduction }
-
- var
- ViewInfo : ViewPortType;
- begin
- MainWindow('');
- GetViewSettings(ViewInfo);
- SetTextStyle(SmallFont, HorizDir,14);
- SetTextJustify(LeftText, TopText);
- with ViewInfo do
- OutTextXY((x2-x1) div 8, (y2-y1) div 8, 'The');
- SetTextStyle(TriplexFont, HorizDir, 4);
- SetTextJustify(RightText, BottomText);
- with ViewInfo do
- OutTextXY((x2-x1)-50, (y2-y1)-50, 'Machine');
- a:=0;
- While a < Maxcolor+1 do
- begin
- SetColor(A);
- SetTextStyle(SansSerifFont, HorizDir,10);
- SetTextJustify(CenterText, CenterText);
- with ViewInfo do
- OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Sound');
- a:=a+1;
- delay(100);
- end;
- s13;
- a:=1;
- While (a < MaxY) and (a < MaxX) do
- begin
- SetColor(RandColor);
- SetLineStyle(SolidLn, 0, 1);
- Circle((MaxX) div 2, (MaxY) div 2, a);
- a:=a+10;
- end;
- s23;
- a:=1;
- While a < 190 do
- begin
- SetColor(0);
- SetLineStyle(SolidLn, 0, 1);
- Circle((MaxX) div 2, (MaxY) div 2, a);
- a:=a+10;
- end;
- s7;
- a:=0;
- While a < 10 do
- begin
- SetBkColor(MaxColor);
- delay(100);
- SetBkcolor(0);
- delay(100);
- a:=a+1;
- end;
- RestoreCrtmode;
- TextColor(black);
- HighVideo;
- TextBackground(cyan);
- ClrScr;
- WriteLn;
- WriteLn;
- WriteLn;
- WriteLn(' The Sound Machine');
- WriteLn;
- WriteLn(' was written by Daniel Bedinger');
- WriteLn; WriteLn(' with special thanks to:');
- WriteLn(' D. Ginskey');
- WriteLn(' O. Wenger');
- WriteLn(' R. Blue');
- WriteLn(' Mr. Reames');
- WriteLn;
- TextColor(Magenta);
- WriteLn('Dedicated to Alex, a true friend. The Best Summer ever! ');
- WriteLn;
- WriteLn;
- LowVideo;
- Textcolor(yellow);
- WriteLn('--------------------------------------NOTE-------------------------------------');
- WriteLn;
- WriteLn(' You are encouraged to share this program with');
- WriteLn(' friends on the conditions that the program is not');
- WriteLn(' modified, and that no fee or consideration is charged.');
- writeln;
- textcolor(white);
- writeln(' Press <Enter> to continue.');
- readln;
- Textcolor(white);
- TextBackground(black);
- ClrScr;
- writeln;
- writeln;
- writeln(' Do you have VGA? ');
- Write(' <Y>es-<N>o] ');
- Ch:=ReadKey;
- If (ch = #121) or (ch = #89) then
- begin
- SetGraphMode(GetGraphMode);
- MainWindow('THE SOUND MACHINE');
- StatusLine('<Press any key for sound> <Esc-exits>');
- GetViewSettings(ViewInfo); { draws speakers }
- SetColor(yellow);
- SetFillStyle(CloseDotFill, lightgray);
- Bar3D(10, 10, MaxX div 2-100, Maxy-50, 0, TopOff);
- Bar3D(MaxX-10, 10, MaxX div 2+100, Maxy-50, 0, TopOff);
- Setcolor(lightBlue);
- a:=90;
- while a > 0 do
- begin
- Circle((MaxX div 2-100) div 2, MaxY div 2, a);
- Circle((MaxX div 2 +200) , MaxY div 2, a);
- a:=a-10;
- end;
- Setcolor(Blue);
- SetFillStyle(WideDotFill, lightgray);
- FillEllipse(MaxX div 2+200, 100, 25, 35);
- FillEllipse((MaxX div 2-100) div 2, 100, 25, 35);
- Setcolor(lightgray);
- SetFillStyle(solidFill, darkgray);
- Bar3d(MaxX div 2-99,200,MaxX div 2+99, maxy-90, 0, TopOff);
- SetLineStyle(solidln, 0, 3);
- Line(MaxX div 2, 100, MaxX div 2, 200);
- Line(MaxX div 2-50, 100, MaxX div 2+50, 100);
- Line(MaxX div 2+40, 80, MaxX div 2-40, 120);
- Line(MaxX div 2-40, 80, MaxX div 2+40, 120);
- setLineStyle(solidln, 0, 1);
- setcolor(lightcyan);
- SetFillStyle(solidFill, black);
- Bar3d(MaxX div 2-95,205,MaxX div 2+95, 225, 0, TopOff);
- Setcolor(white);
- GetViewSettings(Viewinfo);
- SetTextStyle(smallFont, HorizDir, 6);
- SetTextJustify(leftText, topText);
- with ViewInfo do
- OutTextXY(MaxX div 2-85,240, 'Main');
- OutTextXY(MaxX div 2-85,260, 'Surround');
- OutTextXY(MaxX div 2-85,280, 'Loudness');
- OutTextXY(MaxX div 2-85,300, 'Graphics');
- OutTextXY(MaxX div 2-85,320, 'Vol:');
- OutTextXY(MaxX div 2-85,340, 'Bal:');
- OutTextXY(MaxX div 2-85,360, 'Filter:');
- Setcolor(lightred);
- OutTextXY(MaxX div 2+40,240, '*');
- Setcolor(red);
- OutTextXY(MaxX div 2+40,260, '-');
- Setcolor(red);
- OutTextXY(MaxX div 2+40,280, '-');
- Setcolor(lightred);
- OutTextXY(MaxX div 2+40,300, '*');
- Setcolor(cyan);
- OutTextXY(MaxX div 2+30,320, 'Max');
- OutTextXY(MaxX div 2+20,340, '50/50');
- OutTextXY(MaxX div 2+30,360, 'Low');
- StatusLine('<Press any key for sound> <Esc-exits>');
- Setcolor(yellow);
- SetFillStyle(solidFill, yellow);
- Bar3d(MaxX div 2-90,210,MaxX div 2-20, 220, 0, TopOff);
- Setcolor(yellow);
- SetFillStyle(solidFill, darkgray);
- Bar3d(MaxX div 2-19,210,MaxX div 2+90, 220, 0, TopOff);
- end {end of vga speakers}
- else
- begin {ega speakers}
- SetGraphMode(GetGraphMode);
- MainWindow('THE SOUND MACHINE');
- StatusLine('<Press any key for sound> <Esc-exits>');
- GetViewSettings(ViewInfo); { draws speakers }
- SetColor(yellow);
- SetFillStyle(CloseDotFill, lightgray);
- Bar3D(10, 10, MaxX div 2-100, Maxy-50, 0, TopOff);
- Bar3D(MaxX-10, 10, MaxX div 2+100, Maxy-50, 0, TopOff);
- Setcolor(lightBlue);
- a:=90;
- while a > 0 do
- begin
- Circle((MaxX div 2-100) div 2, MaxY div 2, a);
- Circle((MaxX div 2 +200) , MaxY div 2, a);
- a:=a-10;
- end;
- Setcolor(Blue);
- SetFillStyle(WideDotFill, lightgray);
- FillEllipse(MaxX div 2+200, 60, 25, 35);
- FillEllipse((MaxX div 2-100) div 2, 60, 25, 35);
- Setcolor(lightgray);
- SetFillStyle(solidFill, darkgray);
- Bar3d(MaxX div 2-99,100,MaxX div 2+99, maxy-80, 0, TopOff);
- SetLineStyle(solidln, 0, 3);
- Line(MaxX div 2, 30, MaxX div 2, 100);
- Line(MaxX div 2-50, 30, MaxX div 2+50, 30);
- Line(MaxX div 2+40, 10, MaxX div 2-40, 50);
- Line(MaxX div 2-40, 10, MaxX div 2+40, 50);
- setLineStyle(solidln, 0, 1);
- setcolor(lightcyan);
- SetFillStyle(solidFill, black);
- Bar3d(MaxX div 2-95,105,MaxX div 2+95, 125, 0, TopOff);
- Setcolor(white);
- GetViewSettings(Viewinfo);
- SetTextStyle(smallFont, HorizDir, 6);
- SetTextJustify(leftText, topText);
- with ViewInfo do
- OutTextXY(MaxX div 2-85,130, 'Main');
- OutTextXY(MaxX div 2-85,150, 'Surround');
- OutTextXY(MaxX div 2-85,170, 'Loudness');
- OutTextXY(MaxX div 2-85,190, 'Graphics');
- OutTextXY(MaxX div 2-85,210, 'Vol:');
- OutTextXY(MaxX div 2-85,230, 'Bal:');
- OutTextXY(MaxX div 2-85,250, 'Filter:');
- Setcolor(lightred);
- OutTextXY(MaxX div 2+40,130, '*');
- Setcolor(red);
- OutTextXY(MaxX div 2+40,150, '-');
- Setcolor(red);
- OutTextXY(MaxX div 2+40,170, '-');
- Setcolor(lightred);
- OutTextXY(MaxX div 2+40,190, '*');
- Setcolor(cyan);
- OutTextXY(MaxX div 2+30,210, 'Max');
- OutTextXY(MaxX div 2+20,230, '50/50');
- OutTextXY(MaxX div 2+30,250, 'Low');
- StatusLine('<Press any key for sound> <Esc-exits>');
- Setcolor(yellow);
- SetFillStyle(solidFill, yellow);
- Bar3d(MaxX div 2-90,110,MaxX div 2-20, 120, 0, TopOff);
- Setcolor(yellow);
- SetFillStyle(solidFill, darkgray);
- Bar3d(MaxX div 2-19,110,MaxX div 2+90, 120, 0, TopOff);
- end;
- end; { Intro }
-
- procedure SayGoodbye;
- begin
- MainWindow('');
- GetViewSettings(ViewInfo);
- A:=1;
- While A<=8 do
- begin
- SetTextStyle(TriplexFont, HorizDir, a);
- SetTextJustify(CenterText, CenterText);
- Setcolor(15);
- with ViewInfo do
- OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Bye Now!');
- Setcolor(0);
- with ViewInfo do
- OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Bye Now!');
- a:=a+1
- end;
- Setcolor(15);
- with ViewInfo do
- OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Bye Now!');
- StatusLine('Press any key to quit...');
- repeat until KeyPressed;
- end; { SayGoodbye }
-
- procedure Mono1;
- begin
- E:=True;
- TextBackground(black);
- ClrScr;
- LowVideo;
- TextColor(white);
- WriteLn(' ══╦══ ║ ║ ╔═══ ');
- WriteLn(' ║ ╠═══╣ ╠═ ');
- WriteLn(' ║ ║ ║ ╚═══ ');
- WriteLn;
- WriteLn;
- HighVideo;
- TextColor(blink+white);
- WriteLn(' ░░░░░ ░░░░░░ ░ ░ ░░ ░ ░░░ ');
- WriteLn(' ▒▒ ▒▒ ░ ░ ░ ░ ░ ░ ░ ░░ ░░ ');
- WriteLn(' ▓▓ ▒ ▒ ░ ░ ░ ░ ░ ░░ ░░ ');
- WriteLn(' ▓▓ ▓ ▓ ▒ ▒ ░ ░ ░ ░░ ░░ ');
- WriteLn(' ▓▓ ▓ ▓ ▓ ▓ ▒ ▒ ▒ ░░ ░░ ');
- WriteLn(' ▓▓ ▓▓ ▓ ▓ ▓▓ ▓▓ ▓ ▓ ▓ ▒▒ ▒▒ ');
- WriteLn(' ▓▓▓▓▓▓ ▓▓▓▓▓▓ ▓▓▓▓▓▓ ▓ ▓▓ ▓▓▓▓ ');
- WriteLn;
- WriteLn;
- TextColor(white);
- WriteLn(' ▄ ▄ ▄ ▄▄▄▄▄▄▄ ▄▄▄▄▄▄▄ ▄▄▄▄▄ ');
- WriteLn(' ▌▌ ▐▐ ▐ ▌ ▐ ▐ ▌ █ ▌▌ ▌ ▌ ');
- WriteLn(' ▌ ▌ ▐ ▐ ▐ ▌ ▐ ▐▄▄▄▄▌ █ ▌ ▌ ▌ ██ ');
- WriteLn(' ▌ ▌▌ ▐ ▐ ▀▀▀ ▌ ▐ ▐ ▌ █ ▌ ▌▌ ▌ ');
- WriteLn(' ▌ ▐ ▐ ▌ ▀▀▀▀▀▀▀ ▐ ▌ ▀▀▀▀▀▀▀ ▌ ▌ ▀▀▀▀▀ ');
- Delay(2000);s13;s23;s7;delay(4000);
- HighVideo;
- ClrScr;
- WriteLn;
- WriteLn;
- WriteLn;
- WriteLn(' The Sound Machine');
- WriteLn;
- WriteLn(' was written by Daniel Bedinger');
- WriteLn;
- WriteLn(' with special thanks to:');
- WriteLn(' D. Ginskey');
- WriteLn(' O. Wenger');
- WriteLn(' R. Blue');
- WriteLn(' Mr. Reames');
- WriteLn;
- NormVideo;
- WriteLn('Dedicated to Alex, a true friend. The Best Summer ever! ');
- WriteLn;
- WriteLn;
- LowVideo;
- WriteLn('--------------------------------------NOTE-------------------------------------');
- WriteLn;
- WriteLn(' You are encouraged to share this program with');
- WriteLn(' friends on the conditions that the program is not');
- WriteLn(' modified, and that no fee or consideration is charged.');
- repeat until KeyPressed;
-
- { Initialize the video mode, LastCol, LastRow, and the random number }
- { generator. Paint the help line. }
- CheckBreak:=False; { turn off Contrl-C checking }
- OrigMode:=LastMode; { Remember original video mode }
- TextMode(Lo(LastMode));
- LastCol:=Lo(WindMax)+1; { get last column, row }
- LastRow:=Hi(WindMax)+1;
- TextColor(white);
- TextBackground(black);
- WriteLn(' ╔═════════════════╗ ');
- WriteLn(' ║THE SOUND MACHINE║ ');
- WriteLn('╔══════════════════════════════╩═════════════════╩════════════════════════════╗');
- WriteLn('║ ░░░░░░░░░░░░░░░░░░░░░░░░░ ░░░░░░░░░░░░░░░░░░░░░░░░░ ║');
- WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙*∙∙∙∙∙∙∙∙∙∙░░ ┼┼┼┼┼┼┼┼┼ ░░∙∙∙∙∙∙∙∙∙∙*∙∙∙∙∙∙∙∙∙∙░░ ║');
- WriteLn('║ ░░\∙∙∙∙∙∙∙*∙∙∙*∙∙∙∙∙∙∙/░░ │ ░░\∙∙∙∙∙∙∙*∙∙∙*∙∙∙∙∙∙∙/░░ ║');
- WriteLn('║ ░░>>\····*·····*····/<<░░ │ ░░>>\∙∙∙∙*∙∙∙∙∙*∙∙∙∙/<<░░ ║');
- WriteLn('║ ░░>>>>\·*·······*·/<<<<░░ │ ░░>>>>\·*·······*·/<<<<░░ ║');
- WriteLn('║ ░░>>>>>>\·······/<<<<<<░░───────────┴─────────────░░>>>>>>\·······/<<<<<<░░ ║');
- WriteLn('║ ░░>>>>>>>┌──┬──┐<<<<<<<░░»» ««░░>>>>>>>┌──┬──┐<<<<<<<░░ ║');
- WriteLn('║ ░░>>>>>>>│ │ │<<<<<<<░░»» ««░░>>>>>>>│ │ │<<<<<<<░░ ║');
- WriteLn('║ ░░>>>>>>>├──┼──┤<<<<<<<░░║║║║║║║║║║║║║║║║║║║║║║║║║░░>>>>>>>├──┼──┤<<<<<<<░░ ║');
- WriteLn('║ ░░>>>>>>>│ │ │<<<<<<<░░ │ ░░>>>>>>>│ │ │<<<<<<<░░ ║');
- WriteLn('║ ░░>>>>>>>└──┴──┘<<<<<<<░░ Main ■ │ Vol:▓▓▓▓▓ ░░>>>>>>>└──┴──┘<<<<<<<░░ ║');
- WriteLn('║ ░░>>>>/···········\<<<<░░ │ ░░>>>>/···········\<<<<░░ ║');
- WriteLn('║ ░░>>/···············\<<░░ Surround ∙ │ Bal:▓▓▓░░ ░░>>/···············\<<░░ ║');
- WriteLn('║ ░░/···················\░░ ├───────────░░/···················\░░ ║');
- WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ Loudness ∙ │ Filters ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ ║');
- WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ │ Hi ∙ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ ║');
- WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ Mono ■ │ Lo ■ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ ║');
- WriteLn('║ ░░░░░░░░░░░░░░░░░░░░░░░░░─────────────┴───────────░░░░░░░░░░░░░░░░░░░░░░░░░ ║');
- WriteLn('╚═════════════════════════════════════════════════════════════════════════════╝');
-
- GoToXY(1,LastRow); { put message line on screen }
- TextBackground(Black);
- TextColor(White);
- Write(' <Press any key for sound> ',
- ' <Esc-Exit>');
- Dec(LastRow,80 div LastCol); { don't write on message line }
-
- { make typing window }
- Width:=20;
- Height:=0;
- X:=30;
- Y:=10;
- TextBackground(white);
- TextColor(black);
- Window(X,Y,X+Width,Y+1);
- wr;
- end; {Mono1}
- procedure Color1;
- begin
- E:=True;
- TextBackground(blue);
- ClrScr;
- LowVideo;
- TextColor(white);
- WriteLn(' ══╦══ ║ ║ ╔═══ ');
- WriteLn(' ║ ╠═══╣ ╠═ ');
- WriteLn(' ║ ║ ║ ╚═══ ');
- WriteLn;
- WriteLn;
- HighVideo;
- TextColor(blink+lightred);
- WriteLn(' ░░░░░ ░░░░░░ ░ ░ ░░ ░ ░░░ ');
- WriteLn(' ▒▒ ▒▒ ░ ░ ░ ░ ░ ░ ░ ░░ ░░ ');
- WriteLn(' ▓▓ ▒ ▒ ░ ░ ░ ░ ░ ░░ ░░ ');
- WriteLn(' ▓▓ ▓ ▓ ▒ ▒ ░ ░ ░ ░░ ░░ ');
- WriteLn(' ▓▓ ▓ ▓ ▓ ▓ ▒ ▒ ▒ ░░ ░░ ');
- WriteLn(' ▓▓ ▓▓ ▓ ▓ ▓▓ ▓▓ ▓ ▓ ▓ ▒▒ ▒▒ ');
- WriteLn(' ▓▓▓▓▓▓ ▓▓▓▓▓▓ ▓▓▓▓▓▓ ▓ ▓▓ ▓▓▓▓ ');
- WriteLn;
- WriteLn;
- TextColor(black);
- WriteLn(' ▄ ▄ ▄ ▄▄▄▄▄▄▄ ▄▄▄▄▄▄▄ ▄▄▄▄▄ ');
- WriteLn(' ▌▌ ▐▐ ▐ ▌ ▐ ▐ ▌ █ ▌▌ ▌ ▌ ');
- WriteLn(' ▌ ▌ ▐ ▐ ▐ ▌ ▐ ▐▄▄▄▄▌ █ ▌ ▌ ▌ ██ ');
- WriteLn(' ▌ ▌▌ ▐ ▐ ▀▀▀ ▌ ▐ ▐ ▌ █ ▌ ▌▌ ▌ ');
- WriteLn(' ▌ ▐ ▐ ▌ ▀▀▀▀▀▀▀ ▐ ▌ ▀▀▀▀▀▀▀ ▌ ▌ ▀▀▀▀▀ ');
- Delay(2000);s13;s23;s7;delay(4000);
- HighVideo;
- TextBackground(cyan);
- ClrScr;
- WriteLn;
- WriteLn;
- WriteLn;
- WriteLn(' The Sound Machine');
- WriteLn;
- WriteLn(' was written by Daniel Bedinger');
- WriteLn;
- WriteLn(' with special thanks to:');
- WriteLn(' D. Ginskey');
- WriteLn(' O. Wenger');
- WriteLn(' R. Blue');
- WriteLn(' Mr. Reames');
- WriteLn;
- TextColor(Magenta);
- WriteLn('Dedicated to Alex, a true friend. The Best Summer ever! ');
- WriteLn;
- WriteLn;
- LowVideo;
- Textcolor(yellow);
- WriteLn('--------------------------------------NOTE-------------------------------------');
- WriteLn;
- WriteLn(' You are encouraged to share this program with');
- WriteLn(' friends on the conditions that the program is not');
- WriteLn(' modified, and that no fee or consideration is charged.');
- repeat until KeyPressed;
-
- { Initialize the video mode, LastCol, LastRow, and the random number }
- { generator. Paint the help line. }
- CheckBreak:=False; { turn off Contrl-C checking }
- OrigMode:=LastMode; { Remember original video mode }
- TextMode(Lo(LastMode));
- LastCol:=Lo(WindMax)+1; { get last column, row }
- LastRow:=Hi(WindMax)+1;
- TextBackground(black);
- TextColor(yellow);WriteLn(' ╔═════════════════╗ ');
- Write(' ║');
- Textcolor(White);Write('THE SOUND MACHINE');
- Textcolor(yellow);WriteLn('║ ');
- Textcolor(yellow);WriteLn('╔══════════════════════════════╩═════════════════╩════════════════════════════╗');
- Write('║');textcolor(Brown);Write(' ░░░░░░░░░░░░░░░░░░░░░░░░░ ░░░░░░░░░░░░░░░░░░░░░░░░░');
- Textcolor(yellow);WriteLn(' ║');
- Write('║');Textcolor(brown);Write(' ░░');
- Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');
- TextColor(brown);Write('░░');Textcolor(lightgray);Write(' ┼┼┼┼┼┼┼┼┼ ');
- Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');
- Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);write(' ░░');
- Textcolor(white);Write('\∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙');Textcolor(cyan);Write('*');
- Textcolor(white);Write('∙∙∙∙∙∙∙/');Textcolor(brown);Write('░░');Textcolor(lightgray);Write(' │ ');
- Textcolor(brown);Write('░░');Textcolor(white);Write('\∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙');
- Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙∙∙∙∙/');Textcolor(brown);Write('░░');
- Textcolor(yellow);Writeln(' ║');Write('║');Textcolor(brown);Write(' ░░');
- Textcolor(darkgray);Write('>>');Textcolor(white);Write('\····*·····*····/');Textcolor(darkgray);Write('<<');
- Textcolor(brown);Write('░░');Textcolor(lightgray);Write(' │ ');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>');Textcolor(white);Write('\∙∙∙∙*∙∙∙∙∙*∙∙∙∙/');
- Textcolor(darkgray);Write('<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>');
- Textcolor(white);Write('\·*·······*·/');Textcolor(darkgray);Write('<<<<');
- Textcolor(brown);Write('░░');Textcolor(lightgray);Write(' │ ');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>');Textcolor(white);Write('\·*·······*·/');
- Textcolor(darkgray);Write('<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>');
- Textcolor(white);Write('\·······/');Textcolor(darkgray);Write('<<<<<<');
- Textcolor(brown);Write('░░');Textcolor(lightgray);Write('───────────┴─────────────');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>');Textcolor(white);Write('\·······/');
- Textcolor(darkgray);Write('<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('┌──┬──┐');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightcyan);Write('»» ««');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('┌──┬──┐');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│ │ │');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightcyan);Write('»» ««');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│ │ │');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('├──┼──┤');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightgray);Write('║║║║║║║║║║║║║║║║║║║║║║║║║');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('├──┼──┤');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│ │ │');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightgray);Write(' │ ');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│ │ │');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('└──┴──┘');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightblue);Write(' Main ');
- Textcolor(lightred);Write('■');Textcolor(lightgray);Write(' │ ');Textcolor(lightblue);Write('Vol:');
- Textcolor(green);Write('▓▓▓▓▓ ');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('└──┴──┘');
- Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>');Textcolor(white);Write('/···········\');
- Textcolor(darkgray);Write('<<<<');Textcolor(brown);Write('░░');Textcolor(lightgray);Write(' │ ');
- Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>');Textcolor(white);Write('/···········\');
- Textcolor(darkgray);Write('<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>');Textcolor(white);Write('/···············\');
- Textcolor(darkgray);Write('<<');Textcolor(brown);Write('░░');Textcolor(lightblue);Write(' Surround ');
- Textcolor(red);Write('∙');Textcolor(lightgray);Write(' │ ');Textcolor(lightblue);Write('Bal:');
- Textcolor(green);Write('▓▓▓▒▒ ');Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>');
- Textcolor(white);Write('/···············\');Textcolor(darkgray);Write('<<');Textcolor(brown);Write('░░');
- Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('/···················\');Textcolor(brown);Write('░░');
- Textcolor(lightgray);Write(' ├───────────');Textcolor(brown);Write('░░');
- Textcolor(white);Write('/···················\');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
- Textcolor(lightblue);Write(' Loudness ');Textcolor(red);Write(' ∙');Textcolor(lightgray);Write(' │ ');
- Textcolor(lightblue);Write(' Filters ');Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');
- Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
- Textcolor(lightgray);Write(' │ ');Textcolor(lightblue);Write('Hi ');Textcolor(red);Write('∙ ');
- Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
- Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
- Textcolor(lightblue);Write(' Color');Textcolor(lightred);Write(' ■');Textcolor(lightgray);Write(' │ ');
- Textcolor(lightblue);Write('Low ');Textcolor(lightred);Write('■ ');
- Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
- Textcolor(yellow);Writeln(' ║');
- Write('║');Textcolor(brown);Write(' ░░░░░░░░░░░░░░░░░░░░░░░░░');Textcolor(lightgray);Write('─────────────┴───────────');
- Textcolor(brown);Write('░░░░░░░░░░░░░░░░░░░░░░░░░');Textcolor(yellow);Writeln(' ║');
- WriteLn('╚═════════════════════════════════════════════════════════════════════════════╝');
-
- GoToXY(1,LastRow); { put message line on screen }
- TextBackground(Black);
- TextColor(White);
- Write(' <Press any key for sound> ',
- ' <Esc-Exit>');
- Dec(LastRow,80 div LastCol); { don't write on message line }
-
- { make typing window }
- Width:=20;
- Height:=0;
- X:=30;
- Y:=10;
- TextBackground(white);
- TextColor(black);
- Window(X,Y,X+Width,Y+1);
- wr;
- end; {color1}
- procedure start;
- var
- z : boolean;
- begin {start}
- z:=False;
- repeat
- Ch:=ReadKey;
- If E then write(ch);
- case Ch of
- #65, #97: s0; {A}
- #66, #98: s1; {B}
- #67, #99: s2; {C}
- #68, #100: s3; {D}
- #69, #101: s4; {E}
- #70, #102: s5; {F}
- #71, #103: s6; {G}
- #72, #104: s7; {H}
- #73, #105: s8; {I}
- #74, #106: s9; {J}
- #75, #107: s10; {K}
- #76, #108: s11; {L}
- #77, #109: s12; {M}
- #78, #110: s13; {N}
- #79, #111: s14; {O}
- #80, #112: s15; {P}
- #81, #113: s16; {Q}
- #82, #114: s17; {R}
- #83, #115: s18; {S}
- #84, #116: s19; {T}
- #85, #117: s20; {U}
- #86, #118: S21; {V}
- #87, #119: S22; {W}
- #88, #120: S23; {X}
- #89, #121: S24; {Y}
- #90, #122: S25; {Z}
- #48: s26; {0}
- #49: Taps; {1}
- #50: Sw; {2}
- #51: Swars; {3}
- #52: Yd; {4}
- #53: Od; {5}
- #54: Ld; {6}
- #55: Jb; {7}
- #56: Row; {8}
- #57: March; {9}
- #27: z:=True; { Esc }
- #13:
- begin
- if E then wr; { Enter }
- end;
- else
- begin
- Sound(300); Delay(100); NoSound;
- end;
- end;
- until z;
- end;
- procedure ck;
- var
- strng: string;
- i : word;
- x : integer;
- begin
- x:=1;
- for i :=1 to paramcount do
- begin
- if copy(paramstr(i),1,1)='/' then
- begin
- strng :=paramstr(i);
- for x:=1 to length(strng) do
- begin
- strng[x]:=upcase(strng[x]);
- end;
- if strng='/1' then
- begin
- start;
- halt;
- end;
- if strng='/2' then
- begin
- ClrScr;
- Write('A:\>');
- start;
- halt;
- end;
- if strng='/3' then
- begin
- Mono1;
- start;
- wr;
- Write(' Good Bye ...');
- Delay(2000);
- TextBackground(black);
- TextMode(LastMode);
- halt;
- end;
- if strng='/4' then
- begin
- Color1;
- start;
- wr;
- Write(' Good Bye ...');
- Delay(2000);
- TextBackground(black);
- TextMode(LastMode);
- halt;
- end;
- if strng='/5' then
- begin
- Initialize;
- color2;
- start;
- SayGoodbye;
- CloseGraph;
- halt;
- end;
- end
- end;
- end;
- procedure note;
- begin
- ClrScr;
- a:=1;
- writeln(' Color Test ');
- for a:=1 to 15 do
- begin textcolor(a);
- write(' ▓▒░█ ');
- textcolor(a+blink);
- writeln(' ▓▒░█ ');
- end;
- delay(1000);
- ClrScr;
- textcolor(white);
- WriteLn;
- WriteLn(' *** NOTE ***');
- WriteLn(' A quick way to start The Sound Machine;');
- WriteLn(' sm /1 = skips intro');
- Writeln(' sm /2 = fake dos prompt');
- WriteLn(' sm /3 = mono intro');
- WriteLn(' sm /4 = color intro');
- WriteLn(' sm /5 = color2 intro for EGA-VGA');
- WriteLn('------------------------------------------------');
- WriteLn;
- WriteLn(' Press 1 to skip intro');
- WriteLn(' Press 2 to display a fake dos prompt');
- WriteLn(' Press 3 to start a Monocolor intro');
- WriteLn(' Press 4 to start a Color intro');
- WriteLn(' Press 5 to start a Graphics intro');
- WriteLn(' This intro is only for EGA and VGA graphics.');
- WriteLn(' Press Esc to exit');
- writeln;
- WriteLn('--------------------------------------NOTE-------------------------------------');
- WriteLn(' The Sound Machine was written by Daniel Bedinger in Turbo Pascal.');
- WriteLn(' You are encouraged to share this program with');
- WriteLn(' friends on the conditions that the program is not');
- WriteLn(' modified, and that no fee or consideration is charged.');
- end;
-
- begin {main program}
- PrepareTheFonts;
- PrepareTheDrivers;
- ck;
- note;
- repeat
- Ch:=ReadKey;
- case Ch of
- #49: {1}
- begin
- ClrScr;
- start;
- E:=True;
- end;
- #50: {2}
- begin
- ClrScr;
- Write('A:\>');
- start;
- ClrScr;
- E:=True;
- end;
- #51: {3}
- begin
- Mono1;
- start;
- wr;
- Write(' Good Bye ...');
- Delay(2000);
- TextBackground(black);
- TextMode(LastMode);
- end;
- #52: {4}
- begin
- Color1;
- start;
- wr;
- Write(' Good Bye ...');
- Delay(2000);
- TextBackground(black);
- TextMode(LastMode);
- end;
- #53: {5}
- begin
- Initialize;
- color2;
- start;
- SayGoodbye;
- CloseGraph;
- e:=true;
- end;
- #27: E:=True; {esc}
- else
- begin
- Sound(300); Delay(100); NoSound;
- end;
- end;
- until E;
- end.