coding

Web design and programming

-- professional quality, reliable website design and programming since 1996 --

Specializing in providing solutions using the excellent open source Drupal CMS framework, PHP and MySQL. Expertise in setting up and hosting websites, migration of data and websites from older systems, network visualizations, writing new Drupal modules and PHP coding, etc.

Login or register to post comments
Read more

Wikipedia Reflection

Ever wished providing the beauty that is Wikipedia on your own website? Now you can: just include this PHP script wherever you want Wikipedia to appear!

Note: It is highly recommended to temporarily cache pages fetched from Wikipedia. That will assure quicker execution, smaller bandwidth requirements, and also less load on the Wikipedia servers.

Statement published after some e-mails on behalf of Wikimedia Foundation asking me to remove this script:

I don't agree with the Foundation blocking remote loading. We all contribute to the Wikipedia under GFDL and therefore have the right to display the Wikipedia's content. There is no difference between requesting a Wikipedia page via a graphical browser (such as Firefox or Google Chrome) and a command-line browser such as cURL.
The Foundation keeps itself busy blocking remote loading. My own page running this script was blocked. I do not think blocking access is an appropriate way of spending money people donate to the Foundation in hope of increasing free content and openness. While blocking remote loading is not a friendly act taken by the Foundation but in the long term it will prove to be a rather ineffective. A script like this is boringly simple and anyone can write a new one.
I prefer to keep the old simple script up on the page as a reminder of my first assertion.

Cheers,

Tomáš J. Fülöpp

Development of scripts like this can take a lot of time and effort. There are services, e.g. WikiFetcher, that charge incredible fees for a very similar thing!

I do not agree with compulsory pricing. This Wikipedia Reflection script can be used free of charge. However, if you enjoy it, you are encouraged to consider donating a few coins using

Thanks to:

Wikipedia voluntary contributors (distinct from Wikimedia Foundation)
David Polanco and Jim Worthen from aeonity.com
and many others

Future:

It would be really cool to be able to edit Wikipedia from another site (perhaps using Ajax?)
All ideas, snippets of code and comments are very welcome!


<?
# Wiki Reflection Version: 2.3 ( see http://www.vacilando.org/index.php?x=7065 )
# Open source license: GPL

# Make sure to force Unicode for Wikipedia content -- otherwise all foreign scripts will display utter nonsense. This should of course be in your header, though my experimenting shows it may as well stay right here.
  echo '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';

# Make sure images do not display with a border.
  echo '<style TYPE="text/css">
        <!--
        img{border: 0 none;}
        -->
        </STYLE>';

$default_title = 'Vacilando'; # If you do not specify a title, this will be your default page.

$sourceurl = 'http://en.wikipedia.org/wiki/'; # This URL needs adjusting sometimes.
$pathfromroot = substr( $_SERVER['REQUEST_URI'], 0, strpos( $_SERVER['REQUEST_URI'], "?" ) );
$title_wiki = $_GET['title'];
 if ($title_wiki == "") { $title_wiki = $default_title; }
$nicetitle = str_replace( "_", " ", stripslashes( $title_wiki ) );

function callback( $buffer ) {

         global $nicetitle;
         global $title_wiki;
         global $sourceurl;

         # Separate the article content
           $buffer = substr( $buffer, strpos( $buffer, '<!-- start content -->' ) );
           $buffer = substr( $buffer, 0, strpos( $buffer, '<div class="printfooter">' ) );
         # Replace relative links (use another wiki server)
           $buffer = str_replace( '"/w/skin', '"http://en.wikipedia.org/w/skin', $buffer );
           $buffer = str_replace( '"/skins', '"http://en.wikipedia.org/skins', $buffer );
         # Replace relative links (use this server)
           $buffer = str_replace( '"/wiki/', '"' . $pathfromroot . '?title=', $buffer );
         # Remove edit links
           $buffer = str_replace( ">edit<", "><", $buffer );
           $buffer = str_replace( "[<", "<", $buffer );
           $buffer = str_replace( ">]", ">", $buffer );
         $buffer = str_replace( 'href="/w/index.php?', 'target="_blank" href="http://en.wikipedia.org/w/index.php?', $buffer ); # These are typically links to non-existent pages, so the Wikipedia edit page has to open.

         if ( $buffer <> '' ) {
              $buffer = '<table width=100% cellspacing=0 cellpadding=1 bgcolor="#EEEEEE" border=0><tr><td>
                         <p><font size="+2"><b>' . $nicetitle . '</b>&nbsp;<sup><a href="http://en.wikipedia.org/w/index.php?title=' . $title_wiki . '&action=edit" title="Edit this article at Wikipedia" target="_blank"><font color="red" size="-1">edit</font></a></sup></font>
                         <br><i><small>extracted from </small><a href="http://www.wikipedia.org" target="_blank"><small>Wikipedia, the Free Encyclopedia</small></a><small>
                         (using <a href="http://www.vacilando.org/index.php?x=7065"><small>Wikipedia Reflection Script</small></a>)</small></i></td>
                         <td><form method="get"><br><input type="text" name="title" size="30">&nbsp;<input type="submit" value="search"></form></td>
                         <td><div align="right"><a href="http://www.gnu.org/copyleft/fdl.html" target="_blank"><img src="_misc/gnu-fdl.png" border="0"></a></div></td></tr></table><p>' . $buffer;
            } else {
              $buffer = '<p>Unfortunately, no content could be extracted!
                         <p><a href="javascript:history.go(-1)">Return to the previous page</a> or consult the <a target="_blank" href="' . $sourceurl . $title_wiki . '">Wikipedia article on "' . $nicetitle . '"</a>.';
            }

         return $buffer;
       }


# Your page header comes here...'

ob_start("callback");
#include $sourceurl . $title_wiki;
$cuu = new CURL;
echo $cuu -> get( $sourceurl . $title_wiki );
ob_end_flush();

# Your page footer comes here...'



# Define the cURL class:
  class CURL {
     var $callback = false;

     function setCallback($func_name) {
        $this->callback = $func_name;
     }

     function doRequest($method, $url, $vars) {
        $ch = curl_init();
        curl_setopt($ch, CURLOPT_URL, $url);
        #curl_setopt($ch, CURLOPT_HEADER, 1);
        curl_setopt($ch, CURLOPT_USERAGENT, $_SERVER['HTTP_USER_AGENT']);
        #curl_setopt($ch, CURLOPT_USERAGENT, 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)');
        curl_setopt($ch, CURLOPT_FOLLOWLOCATION, 1);
        curl_setopt($ch, CURLOPT_RETURNTRANSFER, 1);
        curl_setopt($ch, CURLOPT_COOKIEJAR, 'cookie.txt');
        curl_setopt($ch, CURLOPT_COOKIEFILE, 'cookie.txt');
        if ($method == 'POST') {
            curl_setopt($ch, CURLOPT_POST, 1);
            curl_setopt($ch, CURLOPT_POSTFIELDS, $vars);
        }
        $data = curl_exec($ch);
        curl_close($ch);
        if ($data) {
            if ($this->callback)
            {
                $callback = $this->callback;
                $this->callback = false;
                return call_user_func($callback, $data);
            } else {
                return $data;
            }
        } else {
            return curl_error($ch);
        }
     }

     function get($url) {
        return $this->doRequest('GET', $url, 'NULL');
     }

     function post($url, $vars) {
        return $this->doRequest('POST', $url, $vars);
     }
  }

?>

Login or register to post comments

GoogLang

This script facilitates translation of web pages on your website using Google's Language Tools. In order to test how it functions, click on any of the flags in the top right corner of this page (or any other one on this website).


<?

/****************************************************************************************************************************************************************

Name: GoogLang
Code developed by: Tomas J. Fulopp ( http://vacilando.net/tf )
Source code: http://vacilando.net/node/264605
First created: 20040321. Last update: 20040328. Version: 1.1
If you have any comment, bug report, or question, please don't hesitate to contact me: i n f o AT vacilando DOT n e t

This script facilitates translation of web pages on your website using Google's Language Tools ( http://translate.google.com ).
Just copy and paste it into your pages. You can obviously replace the words by images of little flags or something else.

The number of languages will presumably increase, so it's worth checking Google's Language Tools from time to time and adjust this script accordingly (in such
case, please let me know, so that I update this script).

This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free 
Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be 
useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 
License for more details. The GNU General Public License is to be found at http://www.gnu.org/licenses/gpl.txt In case you do not find it, write to the 
Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

*****************************************************************************************************************************************************************/

$thisurl = $_SERVER["PHP_SELF"]; // path coming after the domain... e.g. http://www.vacilando.org/research/migration/home.php becomes /research/migration/home.php
if ( $_SERVER['QUERY_STRING'] <> '') {
   $thisurl .= "?" . $_SERVER['QUERY_STRING']; // and we have to add every possible arguments...
   }
$thisurl = 'http://' . $_SERVER["SERVER_NAME"] . $thisurl;
$thisurl = str_replace(":", "%3A", $thisurl);
$thisurl = str_replace("/", "%2F", $thisurl);
$thisurl = str_replace("&", "%26", $thisurl);

?>

<a title="English to German" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=en%7Cde&hl=en&ie=UTF-8&oe=UTF-8">English to German</a> |
<a title="English to Spanish" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=en%7Ces&hl=en&ie=UTF-8&oe=UTF-8">English to Spanish</a> |
<a title="English to French" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=en%7Cfr&hl=en&ie=UTF-8&oe=UTF-8">English to French</a> |
<a title="English to Italian" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=en%7Cit&hl=en&ie=UTF-8&oe=UTF-8">English to Italian</a> |
<a title="English to Portuguese" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=en%7Cpt&hl=en&ie=UTF-8&oe=UTF-8">English to Portuguese</a> |
<a title="German to English" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=de%7Cen&hl=en&ie=UTF-8&oe=UTF-8">German to English</a> |
<a title="German to French" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=de%7Cfr&hl=en&ie=UTF-8&oe=UTF-8">German to French</a> |
<a title="Spanish to English" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=es%7Cen&hl=en&ie=UTF-8&oe=UTF-8">Spanish to English</a> |
<a title="French to English" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=fr%7Cen&hl=en&ie=UTF-8&oe=UTF-8">French to English</a> |
<a title="French to German" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=fr%7Cde&hl=en&ie=UTF-8&oe=UTF-8">French to German</a> |
<a title="Italian to English" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=it%7Cen&hl=en&ie=UTF-8&oe=UTF-8">Italian to English</a> |
<a title="Portuguese to English" href="http://translate.google.com/translate?u=<?echo $thisurl;?>&langpair=pt%7Cen&hl=en&ie=UTF-8&oe=UTF-8">Portuguese to English</a>

Login or register to post comments

TrailScout (old)

A cookie-based PHP script that displays a path of hyperlinks to previously visited pages on a website. For example "Vacilando.Org > Writing > PHP Scripts > TrailScout". It is also known as "cookie crumb trail". None of the similar programs I found around the Web was good enough, so I decided to write my own.

This system does not need to use a database. The path is stored in a cookie for the duration of one session (= until you close all your browser windows). For each new visited page, the title (fetched automatically from between your tags) and the URL (complete with parameters) is stored in that session variable. If user visits a page that s/he has seen before, the trail of links is reduced and that page again becomes the last one in a row. There is a variable that can be used to limit the maximum number of links to be stored (this is useful for large sites where trails tend to be too long).


<?php

/**************************************************************************************************************************************************

Name: TrailScout
Code developed by: Tomas J. Fulopp ( http://vacilando.net/tf )
Source code: http://vacilando.net/node/264603
First created: 20020215. Last update: 20060125, 20091213. Version: 2.1
If you have any comment, bug report, or question, please don't hesitate to contact me: i n f o AT vacilando DOT n e t

A cookie-based PHP script that displays a path of hyperlinks to previously visited pages on a website. For example "vacilando.org > Writing > PHP Scripts >
TrailScout". It is also known as "cookie crumb trail". None of the similar programs I've found around the Web was good enough,
so I decided to write my own. The path is stored in a cookie for the duration of one session (= until you close all your browser windows). For each new visited
page, the title (fetched automatically from between your <TITLE></TITLE> tags) and the url (complete with parameters) is stored in that session
variable. If user visits a page that s/he has seen before, the trail of links is reduced and that page again becomes the last one in a row. There is a variable
that can be used to limit the maximum number of links to be stored (this is useful for large sites where trails tend to be too long).

Save the whole script as e.g. "trailscout.php". You can then include it in your PHP pages using:
    $relroot = ""; // relative path to the folder where this script is located, e.g. "../scripts/"
    include ($relroot . 'trailscout.php');
and the click path can then be displayed by
    echo $trailscout_show;

Make sure that TrailScout is the first script to run on your page; since the cookie needs to be set, it is vital that this program is run before
any HTML code is output to the website.

This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
License for more details. The GNU General Public License is to be found at http://www.gnu.org/licenses/gpl.txt In case you do not find it, write to the
Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

*****************************************************************************************************************************************************/

   # First we need to get the title of the page we are visiting (i.e. what is betweeen <title></title>
   $thispage = str_replace("/", "", $_SERVER["PHP_SELF"]); # This works for pages in the web root. For pages in folders you have to adapt it, e.g. to $thispage = SUBSTR($_SERVER["PHP_SELF"], STRPOS($_SERVER["PHP_SELF"], "/", 2) +1 );
   $fp = fopen( $thispage, 'r');
   while ( !feof($fp) )
         {
           $stuff .= fgets($fp, 1024);
           if ( stristr($stuff, '</title>' )) { break; }
         }
   eregi("<title>(.*)</title>", $stuff, $title );
   $title = $title[1];

/*
   Here starts the TrailScout code itself. First we'll make an element to store in the cookie, consisting of two parts:
   the script name and path (with all parameters), delimiter (~), then the page title, and then element delimiter (^)
   E.g.: "/travel/photos.php?go=11~Travel Photographs^"
*/

// Maximum number of past links in the trail.
   $maxlinks = 17;
// My domain
   $mydomain = "vacilando.org";

$params = $_SERVER["QUERY_STRING"];
if ( $params <> "" ) { $params = "?" . $params; }
// Remove all kinds of quotation marks from the title that goes into cookie. Otherwise malfunctions
   $titleforcookie = str_replace("'", "%%%", $title);
   $titleforcookie = str_replace('"', '%%%', $titleforcookie);
//echo $title;
$currentpage = $_SERVER["PHP_SELF"] . $params . "~" . trim( $titleforcookie ) . "^";

$trailscout = $_COOKIE['trailscout'];
if ( $trailscout == '' )
   {
     $trailscout = $currentpage;
   } else {
      if ( strstr( $trailscout, $currentpage ) <> false )  // Means we have been on that page already. Cut everything that follows it, from the trail string..
         {
            $pos = strpos( $trailscout, $currentpage );
            $len = $pos + strlen( $currentpage );
            $trailscout = substr( $trailscout, 0, $len );
         } else
         {
            // If there are more than $maxlinks then remove the first one.
               If ( substr_count ( $trailscout, '~' ) == $maxlinks )
                  {
                    $trailscout = strstr ( $trailscout, '^' );
                    $trailscout = substr ( $trailscout, 1 ); // Removes initial '^'
                  }
            $trailscout = $trailscout . $currentpage;
         }
   }
setcookie ( "trailscout", $trailscout, '0', '/', '.' . $mydomain ); // Setting a session cookie (somehow, in IE, value had to be 0, although read that it should be nothing...)

/*
if ( !session_is_registered('trailscout') )
   {
     session_register('trailscout');
     $trailscout = $currentpage;
   } else {
     if ( strstr( $trailscout, $currentpage ) ) {
          $pos = strpos( $trailscout, $currentpage );
          $len = $pos + strlen( $currentpage );
          $trailscout = substr( $trailscout, 0, $len );
          } else {
          $trailscout = $trailscout . $currentpage;
          }
   }
*/

$line = explode( "^", $trailscout );
$item = explode( "~", $line[0] );
$trailscout_show = '<a href="' . $item[0] . '"><font color="';
$trailscout_show .= '#000000';
$trailscout_show .= '">' . $item[1] . '</FONT></a>';
$countline = count( $line ) - 1; // Min 1 because there's always a delimiter at the end but nothing after it.
if ( $countline > 1 )
   {
     for ( $x = 1; $x <= $countline - 1; $x++ ) // Min 1 because array starts from zero.
         {
           $item = explode ( "~", $line[$x] );
           $trailscout_show .= ' <font color="';
           $trailscout_show .= '#000000';
           $trailscout_show .= '">></FONT> ' . '<a href="' . $item[0] . '"><font color="';
           $trailscout_show .= '#000000';
           $item[1] = str_replace("%%%", "'", $item[1]);
           $trailscout_show .= '">' . $item[1] . '</FONT></a>';
         }
   }


/* Here's the HTML beginning of the actual page (remember that html output can only start AFTER setcookie!) The information in between TITLE tags will be used for display in TrailScout. */

<HTML>
<TITLE>Title of This Page</TITLE>
<BODY>

# Now we can print out the path:
  echo $trailscout_show;

</BODY>
</HTML>

?>

Login or register to post comments

Galaxis: a calendar and encrypting program written in GFA Basic on Commodore Amiga

REM ---------------------------------------------------------------------------
REM THE NEW VERSION OF g a l a x i s
REM TOMAS J. FULOPP in POPRAD, SLOVAKIA, JUNE 1993 (PHONE +42 - (0)92 - 32814)
REM GALAXIS WAS UPDATED ALL THE TIME, BUT RADICALLY IN FEBRUARY 1994
REM MAJOR UPDATE OF CHESTER ENCRYPTER & SETMAP TRANSFORMERS ADD IN MARCH 3, 1995
REM ---------------------------------------------------------------------------
REM up 155 65, down 155 66, right 155 67, left 155 68
REM Sun 7.12.1941; Wed 2.10.1872; Sat 21.12.1872; Sun 22.10.1944
REM ---------------------------------------------------------------------------
REM !!! ADD, SUB, MUL, DIV, PRED, SUCC ... pracuju len s celociselnymi operandami !!!
RESERVE 500000
REM OPENS 1,0,0,640,512,4,32772
REM OPENS 1,0,0,640,256,4,32768
REM ked nieco nepojde, pozriet sa na toto zadanie okna; velmi dolezite
REM OPENW #1,0,0,320,256,0,1+16+32+2+4+8+0+4096
REM OPENW #1,0,0,640,512,0,1+16+32+2+4+8+0+4096
REM OPENW #1,0,0,640,256,0,2048
OPENW #1
FULLW #1
svet%=2147483647
maxpocetitemov&=7000
DIM menu$(43)
DIM datumcislo%(maxpocetitemov&)
DIM itemfirst%(maxpocetitemov&)
DIM d$(7)
DIM m&(12)
DIM tesla|(2023)
DIM slava$(maxpocetitemov&)
DIM sorted$(maxpocetitemov&)
DIM adresa$(maxpocetitemov&)
DIM riadok$(maxpocetitemov&)
DIM alarm$(255)
DIM amessage$(255)
REM Nasledujuci DIM pass|(255) je tu kvoli CHESTER koderu
DIM pass|(255)
REM DIM john|(90) je tu kvoli transformatorom !
DIM john|(90)
annual!=TRUE
REM --------------------------------
REM ako vztazny den je dany PONDELOK 14.6.1993 (24 tyzden (western model)):
etalonday&=14
etalonmonth&=6
etalonyear%=1993
bbetalon%=727743
betalon&=1
REM --------------------------------
actualdate
menu$(0)="CALENDAR "
menu$(1)="DATE "
menu$(2)="!CURRENT DATE "
menu$(3)="!INSERT NEW DATE "
menu$(4)="SORT FILE "
menu$(5)="!DAYS FROM NOW "
menu$(6)="!MONTHS FROM NOW "
menu$(7)="!YEARS FROM NOW "
menu$(8)="! ANNUAL ITEMS"
menu$(9)="QUIT "
menu$(10)=""
menu$(11)="FILES "
menu$(12)="PLATYS"
menu$(13)="!EDIT ADDRESSES.PBX "
menu$(14)="!EDIT SORTEDPLATYS.PBX"
menu$(15)="NOTES"
menu$(16)="!EDIT NOTES.PBX "
menu$(17)="ADDRESSES"
menu$(18)="!EDIT ADDRESSES.PBX "
menu$(19)="!FIND ADDRESSES "
menu$(20)="!FIND TODAYS ADDRESSES "
menu$(21)="!EDIT SORTEDADDRESSES "
menu$(22)="LITERATURE"
menu$(23)="!EDIT LITERATURE.PBX "
menu$(24)="!BOOK PROCESSOR "
menu$(25)=""
menu$(26)="OTHERS "
menu$(27)="SOLAR SYSTEM "
menu$(28)="CHESTER CODER "
menu$(29)="MESSAGE ALARM "
menu$(30)=""
menu$(31)="TRANSFORMERS "
menu$(32)="TOM --> TRANS"
menu$(33)="TRANS --> TOM"
menu$(34)="TOM --> KOI"
menu$(35)="KOI --> TOM"
menu$(36)="TOM --> TWIG"
menu$(37)="TWIG --> TOM"
menu$(38)="PBX --> KOI"
menu$(39)="KOI --> PBX"
menu$(40)="PBX --> TRANS"
menu$(41)="TRANS --> PBX"
menu$(42)=""
menu$(43)=""
MENU menu$()
MENU KEY 2,ASC("C")
MENU KEY 3,ASC("I")
MENU KEY 5,ASC("D")
MENU KEY 6,ASC("M")
MENU KEY 7,ASC("Y")
MENU 8,16+64+256
MENU KEY 9,ASC("Q")
MENU KEY 13,ASC("P")
MENU KEY 16,ASC("N")
MENU KEY 18,ASC("A")
MENU KEY 19,ASC("F")
MENU KEY 20,ASC("T")
MENU KEY 23,ASC("L")
MENU KEY 24,ASC("B")
MENU KEY 27,ASC("S")
MENU KEY 28,ASC("H")
MENU KEY 29,ASC("R")
ON MENU GOSUB menu
weekday
currentdateonscreen
currentitemonscreen
DO
  FOR budi|=1 TO budikov|
    IF TIME$=alarm$(budi|) OR TIME$=LEFT$(alarm$(budi|),5)+":07"
      FRONTS 1
      CLS
      currentdateonscreen
      PRINT AT(6,6);"(";budi|;".) ";alarm$(budi|);" ";amessage$(budi|)
      PRINT AT(16,28);"### HIT SPACE TO CONFIRM ###"
      WHILE INKEY$=""
      WEND
      CLS
      weekday
      currentdateonscreen
      currentitemonscreen
      BACKS 1
    ENDIF
  NEXT budi|
  currentdateonscreen
  ink$=INKEY$
  IF ASC(LEFT$(ink$))=155 AND ASC(RIGHT$(ink$))=68
    REM DOLAVA
    IF day&>1
      DEC day&
    ELSE
      IF FRAC(year%/4)=0 AND month&=3 AND day&=1
        day&=29
        month&=2
      ELSE IF month&=1 AND day&=1
        IF year%>1
          day&=31
          month&=12
          DEC year%
        ENDIF
      ELSE IF day&=1
        DEC month&
        day&=m&(month&)
      ENDIF
    ENDIF
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  ELSE IF ASC(LEFT$(ink$))=155 AND ASC(RIGHT$(ink$))=67
    REM DOPRAVA
    IF FRAC(year%/4)=0 AND month&=2 AND day&=28
      day&=29
    ELSE IF day&=31 AND month&=12
      IF year%<svet%
        day&=1
        month&=1
        INC year%
      ENDIF
    ELSE IF day&=m&(month&)
      day&=1
      INC month&
    ELSE IF day&<m&(month&)
      INC day&
    ENDIF
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  ENDIF
  ON MENU
  PRINT AT(6,28);"*** ARROWS <-- --> DE/INCREASE THE DATE ***"
LOOP
REM ---------------------------------------------------------------------------
REM ---------------------------------------------------------------------------
REM ZA TYMTO RIADKOM BUDU SPOCIVAT VSETKY PROCEDURY
REM ---------------------------------------------------------------------------
PROCEDURE menu
  agfa&=MENU(0)
  SELECT agfa&
  CASE 2
    REM CURRENT DATE
    actualdate
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 3
    REM INSERT NEW DATE
    CLS
    PRINT AT(9,22);"LEAVE BLANK TO SET CURRENT DATE"
    PRINT AT(9,10);"ENTER DAY....... ";
    FORM INPUT 2,day$
    PRINT AT(9,11);"ENTER MONTH..... ";
    FORM INPUT 2,month$
    PRINT AT(9,12);"ENTER YEAR...... ";
    FORM INPUT 10,year$
    IF day$=""
      day&=VAL(LEFT$(DATE$,2))
    ELSE
      day&=VAL(day$)
    ENDIF
    IF month$=""
      month&=VAL(MID$(DATE$,4,2))
    ELSE
      month&=VAL(month$)
    ENDIF
    IF year$=""
      year%=VAL(RIGHT$(DATE$,4))
    ELSE
      year%=VAL(year$)
    ENDIF
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 5
    REM SORT ADDRESSES.PBX DAYS FROM NOW
    esav:
    CLS
    PRINT AT(9,10);
    INPUT "ENTER NUMBER OF DAYS TO SHOW: ",numb%
    CLR ano|
    IF FRAC(year%/4)=0
      ano|=1
    ENDIF
    IF numb%<1 OR numb%>ADD(365,ano|)
      GOTO esav
    ENDIF
    TITLEW #1," SORT "+STR$(numb%)+" DAYS AHEAD"
    sortsave
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 6
    REM SORT ADDRESSES.PBX MONTHS FROM NOW
    esavv:
    CLS
    PRINT AT(9,10);
    INPUT "ENTER NUMBER OF MONTHS TO SHOW: ",numb%
    IF numb%<1 OR numb%>12
      GOTO esavv
    ENDIF
    TITLEW #1," SORT "+STR$(numb%)+" MONTHS AHEAD"
    REM POCET DNI JE TU RATANY AKO ZE DNI V MESIACI JE 31 (LEPSIE VIAC AKO MENEJ!)
    MUL numb%,31
    CLR ano|
    IF FRAC(year%/4)=0
      ano|=1
    ENDIF
    IF numb%>ADD(365,ano|)
      numb%=ADD(365,ano|)
    ENDIF
    sortsave
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 7
    REM SORT ADDRESSES.PBX YEARS FROM NOW
    esavvv:
    CLS
    PRINT AT(9,10);
    INPUT "ENTER NUMBER OF YEARS TO SHOW: ",numb%
    IF numb%<1
      GOTO esavvv
    ENDIF
    TITLEW #1," SORT "+STR$(numb%)+" YEARS AHEAD"
    REM POCET DNI JE TU RATANY AKO ZE DNI V ROKU JE 366 (LEPSIE VIAC AKO MENEJ!)
    MUL numb%,366
    sortsave
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 8
    IF annual!=TRUE
      MENU 8,16+64
      annual!=FALSE
    ELSE IF annual!=FALSE
      MENU 8,16+64+256
      annual!=TRUE
    ENDIF
  CASE 9
    CLOSE
    CLOSES 1
    EDIT
  CASE 13
    c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/NOTES.PBX",0,0)
  CASE 14
    c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/SORTEDPLATYS.PBX",0,0)
  CASE 16
    c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/NOTES.PBX",0,0)
  CASE 18
    c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/NOTES.PBX",0,0)
  CASE 19
    TITLEW #1," ADDRESS FIND IS CASE SENSITIVE ! "
    CLS
    PRINT AT(3,10);
    INPUT "ENTER A SIGNIFICANT STRING: ",signi$
    CLS
    TITLEW #1," ADDRESS FIND - "+signi$
    PRINT AT(1,2);
    GOTO pokracujeme
  CASE 20
    CLS
    signi$=STR$(day&)+"."+STR$(month&)
    TITLEW #1," FIND TODAY'S ADDRESSES - "+signi$
    PRINT AT(1,2);
    pokracujeme:
    OPEN "i",#13,"HDW:Super-Data/Words/NOTES/NOTES.PBX"
    IF lofa%=0 OR lofa%<>LOF(#13)
      lofa%=LOF(#13)
      FOR ax%=1 TO svet%
        LINE INPUT #13,adresa$
        EXIT IF LEFT$(adresa$,10)=" COLLECTED"
      NEXT ax%
      FOR ax%=1 TO svet%
        LINE INPUT #13,adresa$(ax%)
        EXIT IF EOF(#13)
      NEXT ax%
    ENDIF
    CLOSE #13
    OPEN "o",#2,"HDW:Super-Data/Words/NOTES/SORTEDADDRESSES.PBX"
    CLR as%
    DO
      INC as%
      EXIT IF adresa$(as%)=""
    LOOP
    zaciatok%=as%
    DO
      DO
        INC as%
        REM VYPOTIL SOM KENGURU - JE 3 a.m. - PRIKAZ INSTR MENI HODNOTU LOC(#1) !!!!!!
        IF INSTR(adresa$(as%),signi$)<>0
          as%=zaciatok%
          DO
            INC as%
            PRINT adresa$(as%)
            PRINT #2,adresa$(as%)
            EXIT IF adresa$(as%)="" OR as%=ax%
          LOOP
        ENDIF
        EXIT IF adresa$(as%)="" OR as%=ax%
      LOOP
      EXIT IF as%=ax%
      IF adresa$(as%)=""
        zaciatok%=as%
      ENDIF
    LOOP
    CLOSE #2
    PRINT
    PRINT SPC(9);"*** PRESS ANY KEY TO RETURN TO THE MAIN MENU ***"
    FRONTS 1
    WHILE INKEY$=""
    WEND
    CLS
    currentdateonscreen
    currentitemonscreen
  CASE 21
    c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/SORTEDADDRESSES.PBX",0,0)
  CASE 23
    c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/LITERATURE.PBX",0,0)
  CASE 24
    CLS
    TITLEW #1," BOOK PROCESSOR "
    OPEN "i",#7,"HDW:Super-Data/Words/NOTES/LITERATURE.PBX"
    IF lofb%=0 OR lofb%<>LOF(#7)
      lofb%=LOF(#7)
      FOR kx%=1 TO svet%
        LINE INPUT #7,riadok$(kx%)
        EXIT IF EOF(#7)
      NEXT kx%
    ENDIF
    CLOSE #7
    CLR aut%
    CLR pre%
    CLR nep%
    PRINT AT(9,4);"THE BOOK PROCESSOR PART OF GALAXIS"
    PRINT AT(9,6);"WAS MADE ON FEBRUARY 10, 1994 IN POPRAD"
    PRINT AT(9,10);"NUMBER OF AUTHORS: "
    PRINT AT(9,12);"NUMBER OF READ BOOKS: "
    PRINT AT(9,14);"NUMBER OF UNREAD BOOKS: "
    PRINT AT(9,16);"NUMBER OF ALL BOOKS: "
    PRINT AT(9,20);"RATIO UNREAD / ALL BOOKS: "
    FOR cx%=1 TO kx%
      autor&=INSTR(riadok$(cx%),"$")
      precitane&=INSTR(riadok$(cx%),"*")
      neprecitane&=INSTR(riadok$(cx%),"=")
      IF (autor&<>0 AND precitane&<>0) OR (autor&<>0 AND neprecitane&<>0) OR (precitane&<>0 AND neprecitane&<>0)
        PRINT
        PRINT " FIRST PLEASE SOLVE THIS PROBLEM:"
        PRINT
        PRINT riadok$(cx%)
        WHILE INKEY$=""
        WEND
        CLOSE
        EDIT
      ENDIF
      IF autor&<>0
        INC aut%
      ELSE IF precitane&<>0
        INC pre%
      ELSE IF neprecitane&<>0
        INC nep%
      ENDIF
      PRINT AT(35,10);aut%
      PRINT AT(35,12);pre%
      PRINT AT(35,14);nep%
      PRINT AT(35,16);ADD(pre%,nep%)
      IF ADD(pre%,nep%)<>0
        PRINT AT(35,20);nep%/((ADD(pre%,nep%))/100);" %";SPC(15)
      ENDIF
    NEXT cx%
    PRINT AT(9,25);"*** PRESS ANY KEY TO RETURN TO THE MAIN MENU ***"
    FRONTS 1
    WHILE INKEY$=""
    WEND
    CLS
    currentdateonscreen
    currentitemonscreen
  CASE 27
    solarsystem
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 28
    chester
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 29
    budiznova:
    budivyskoc!=FALSE
    CLS
    PRINT AT(6,3);"HOW MANY ALARMS YOU WANT TO KEY IN ? - ";
    FORM INPUT 2,budikov$
    budikov|=VAL(budikov$)
    PRINT
    FOR budi|=1 TO budikov|
      PRINT
      PRINT
      PRINT " (";budi|;".) ENTER ALARM TIME....... ";
      FORM INPUT 5,alarm$(budi|)
      IF MID$(alarm$(budi|),1,1)=" "
        MID$(alarm$(budi|),1,1)="0"
      ENDIF
      IF MID$(alarm$(budi|),2,1)=":"
        alarm$(budi|)="0"+alarm$(budi|)
      ENDIF
      EXIT IF MID$(alarm$(budi|),3,1)<>":"
      alarm$(budi|)=alarm$(budi|)+":00"
      PRINT
      PRINT " (";budi|;".) ENTER ALARM MESSAGE :"
      PRINT " ";
      INPUT amessage$(budi|)
    NEXT budi|
    IF MID$(alarm$(budi|),3,1)<>":" AND budi|<=budikov|
      PRINT
      PRINT
      PRINT " WRONG TIME - TRY ONCE AGAIN !!!"
      DELAY 7
      GOTO budiznova
    ENDIF
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 32
    REM "TOM --> TRANS"
    tomtrans
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 33
    REM "TRANS --> TOM"
    transtom
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 34
    REM "TOM --> KOI"
    tomkoi
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 35
    REM "KOI --> TOM"
    koitom
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 36
    REM "TOM --> TWIG"
    tomtwig
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 37
    REM "TWIG --> TOM"
    twigtom
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 38
    REM "PBX --> KOI"
    pbxkoi
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 39
    REM "KOI --> PBX"
    koipbx
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 40
    REM "PBX --> TRANS"
    pbxtrans
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  CASE 41
    REM "TRANS --> PBX"
    transpbx
    CLS
    weekday
    currentdateonscreen
    currentitemonscreen
  ENDSELECT
RETURN
REM ---------------------------------------------------------------
PROCEDURE actualdate
  REM EXTRAHOVANIE SKUTOCNEHO AKTUALNEHO DATUMU DO PREMENNYCH day&, month&, year%
  day&=VAL(LEFT$(DATE$,2))
  month&=VAL(MID$(DATE$,4,2))
  year%=VAL(RIGHT$(DATE$,4))
RETURN
REM ---------------------------------------------------------------
PROCEDURE currentdateonscreen
  IF m&(2)=29
    PRINT AT(6,3);day&;".";month&;".";year%;" "+d$(b&)+" "+TIME$+" ";tyzden%;".WEEK ";denvroku%;".DAY LEAP YEAR";SPC(5)
  ELSE IF m&(2)=28
    PRINT AT(6,3);day&;".";month&;".";year%;" "+d$(b&)+" "+TIME$+" ";tyzden%;".WEEK ";denvroku%;".DAY NOT LEAP YEAR";SPC(5)
  ENDIF
RETURN
REM ---------------------------------------------------------------
PROCEDURE currentitemonscreen
  TITLEW #1,"*********************************** GALAXIS ***********************************"
  REM NA OBRAZOVKE SA UKAZU ALL ITEMs PRE CURRENT DATE
  REM TERAZ: AK ESTE ADDRESSES NIE JE V PAMATI, ALEBO AK SA ZMENILA JEHO DLZKA, TAK SA NAHRAJA ZNOVA
  GOTO skok
  OPEN "i",#1,"DH3:Words/NOTES/NOTES.PBX"
  IF lof%=0 OR LOF(#1)<>lof%
    CLR bloch&
    lof%=LOF(#1)
    REM Teraz sa citac nastavi na prvy riadok adries:
    FOR riadky%=1 TO svet%
      LINE INPUT #1,slava$
      EXIT IF LEFT$(slava$,3)=" *"
    NEXT riadky%
    FOR riadky%=1 TO svet%
      LINE INPUT #1,slava$(riadky%)
      EXIT IF EOF(#1)
      IF slava$(riadky%)=""
        INC bloch&
      ENDIF
    NEXT riadky%
  ENDIF
  CLOSE #1
  skok:
  aatum$=STR$(day&)+"."+STR$(month&)
  atum$=STR$(day&)+"."+STR$(month&)+"."+STR$(year%)
  lin|=8
  CLR super&
  FOR nx%=1 TO riadky%
    IF slava$(nx%)=aatum$ OR slava$(nx%)=atum$
      DO
        INC nx%
        PRINT AT(6,lin|);slava$(nx%)
        EXIT IF slava$(nx%)=""
        INC lin|
        EXIT IF nx%=riadky%
      LOOP
    ENDIF
    IF slava$(nx%)=""
      INC super&
    ENDIF
  NEXT nx%
  PRINT AT(6,5);"Number of items: ";super&;" out of ";lof%;" bytes"
RETURN
REM ---------------------------------------------------------------
PROCEDURE weekday
  REM POKIAL IDE O TYZDEN - NASE KALENDARE OCISLUJU CISLOM 1 TYZDEN, V KTOROM
  REM SA OBJAVI 1.JANUAR a MAJU TEDA 53 TYZDNOV; ZAHRANICNE ZACNU TYZDEN c. 1
  REM AZ PRVYM JANUAROVYM PONDELKOM. JA POUZIJEM ZAHRANICNY MODEL (52 TYZDNOV,
  REM ALE AJ 53 V PRIPADE, KED JE PRESTUPNY ROK A POSLEDNY 366. DEN JE PONDELOK)
  REM NASLEDUJUCE VYPOCITA DEN V TYZDNI A PORADIE TYZDNA V ROKU
  RESTORE kalendar
  FOR n&=1 TO 7
    READ d$(n&)
  NEXT n&
  FOR n&=1 TO 12
    READ m&(n&)
  NEXT n&
  IF FRAC(year%/4)=0
    m&(2)=29
  ELSE
    m&(2)=28
  ENDIF
  REM tesla|(rok 1996-2023) je pole, kde su pre dane roky uvedene januarove datumy,
  REM ktore zodpovedaju prvemu tyzdnu roka podla western modelu (prvy januarovy pondelok)
  FOR n&=1996 TO 2023
    READ tesla|(n&)
  NEXT n&
  REM MAM DOVOD NEDAT VSETKY PODMIENKY DO JEDNEHO IF-u !!!
  wrongdate!=FALSE
  IF month&<1 OR month&>12
    wrongdate!=TRUE
    GOTO tarzan
  ELSE
    IF year%<1 OR year%>svet% OR day&<1 OR day&>m&(month&)
      wrongdate!=TRUE
      GOTO tarzan
    ENDIF
  ENDIF
  REM toto je pocet dni od zaciatku letopoctu po koniec predosleho roka
  bb%=ADD(MUL(365,(PRED(year%))),TRUNC((PRED(year%))/4))
  denvroku%=bb%
  REM pricita sa pocet dni do konca minuleho mesiaca
  FOR n&=1 TO PRED(month&)
    ADD bb%,m&(n&)
  NEXT n&
  REM PLUS DEN V TOMTO MESIACI; V bb% JE TEDA CELK. POCET DNI OD ROKU 0 DODNES:
  ADD bb%,day&
  REM denvroku% je poradove cislo daneho dna v danom roku
  denvroku%=SUB(bb%,denvroku%)
  REM b& = ETALONOVY DEN V TYZDNI (1 = PONDELOK, 14.6.1993)
  b&=betalon&
  REM dilu% = ETALONOVE PORADOVE CISLO DNA OD ROKU 0 DO DNA ETALONOVEHO DATUMU
  dilu%=bbetalon%
  sss%=70000000
  tyzden%=1
  REM AK bb%=dilu% SKOCI ZA IF-y A BUDU PLATIT ETALONOVE UDAJE b& (a d$(b&) a tyzden%)
  IF bb%>dilu%
    REM TATO SLUCKA JE ZAZRAKOM - ZMENSI ROZDIEL MEDZI bb% A dilu% NA MENSI,
    REM ALEBO ROVNY 7 A V DALSEJ SLUCKE SA POTOM UZ DOPOCITA PRESNY DEN...
    REM A TYZDEN. POZOR !!! V sss% MUSI BYT CISLO DELITELNE 7 a 10, ABY PRI
    REM PRIBLIZOVANI BOL STALE PONDELOK
    FOR bang|=1 TO 7
      sss%=sss%/10
      FOR roky%=dilu% TO svet% STEP sss%
        IF roky%>bb%
          dilu%=SUB(roky%,sss%)
        ENDIF
        EXIT IF roky%>bb%
      NEXT roky%
    NEXT bang|
    FOR roky%=SUCC(dilu%) TO bb%
      INC b&
      IF b&=8
        b&=1
      ENDIF
    NEXT roky%
  ELSE IF bb%<dilu%
    REM TATO SLUCKA JE ZAZRAKOM - ZMENSI ROZDIEL MEDZI bb% A dilu% NA MENSI,
    REM ALEBO ROVNY 7 A V DALSEJ SLUCKE SA POTOM UZ DOPOCITA PRESNY DEN...
    REM A TYZDEN. POZOR !!! V sss% MUSI BYT CISLO DELITELNE 7 a 10, ABY PRI
    REM PRIBLIZOVANI BOL STALE PONDELOK
    FOR bang|=1 TO 7
      sss%=sss%/10
      FOR roky%=dilu% TO -svet% STEP -sss%
        IF roky%<bb%
          dilu%=ADD(roky%,sss%)
        ENDIF
        EXIT IF roky%<bb%
      NEXT roky%
    NEXT bang|
    FOR roky%=PRED(dilu%) DOWNTO bb%
      DEC b&
      IF b&=0
        b&=7
      ENDIF
    NEXT roky%
  ENDIF
  REM -----------------------------
  REM VYPOCET TYZDNA
  podoba%=year%
  DO
    EXIT IF podoba%>=1996 AND podoba%<=2023
    IF podoba%<1996
      ADD podoba%,28
    ELSE IF podoba%>2023
      SUB podoba%,28
    ENDIF
  LOOP
  REM teraz sa vypocita pocet dni od zaciatku letopoctu po prvy januarovy
  REM pondelok tzv. podobneho roka; potrebne pre vypocet tyzdna:
  special%=ADD(MUL(365,PRED(podoba%)),ADD(TRUNC((PRED(podoba%))/4),tesla|(podoba%)))
  REM toto je pocet dni od zaciatku letopoctu po dany den, ale V tzv. PODOBNOM ROKU !
  bbspecial%=ADD(MUL(365,PRED(podoba%)),TRUNC((PRED(podoba%))/4))
  FOR n&=1 TO PRED(month&)
    ADD bbspecial%,m&(n&)
  NEXT n&
  ADD bbspecial%,day&
  REM NASLEDUJUCE SA VYKONA AK JE TO ESTE 52 (53) TYZDEN (WESTERN MODEL)
  IF day&<tesla|(podoba%) AND month&=1
    REM AK BOL PREDOSLY ROK PODOBNY ROKU 2012 (PRESTUPNY A ZACINA NEDELOU), TAK
    REM BOL POSLEDNY DEN (c. 366) PONDELOK, CO JE JEDINY PRIPAD VO WESTERN
    REM MODELE (RAZ ZA 28 ROKOV) KED MA ROK 53 TYZDNOV
    IF PRED(podoba%)=2012
      tyzden%=53
    ELSE
      tyzden%=52
    ENDIF
    GOTO tarzan
  ENDIF
  REM NASLEDUJUCA SLUCKA UROBI ROZDIEL O NULA AZ 7 DNI NAD bb%
  DO
    EXIT IF SUB(special%,bbspecial%)>=0 AND SUB(special%,bbspecial%)<7
    ADD special%,7
    INC tyzden%
  LOOP
  REM NASLEDUJUCI IF RIESI AK JE DEN (CISLO b&) V PREDOSLOM TYZDNI AKO tyzden%
  IF ADD(SUB(special%,bbspecial%),b&)>7
    DEC tyzden%
  ENDIF
  REM --------------------------
  tarzan:
  REM TU SA RIESI wrongdate!, ALE OKREM 29.FEB, TEN SA RIESI V sortsave
  IF wrongdate!=TRUE AND (day&<>29 AND month&<>2)
    PRINT AT(6,10);"DATE ";day&;".";month&;".";year%;" IS WRONG, CHANGE IT IN ADDRESSES.PBX FILE"
    PRINT AT(6,15);"*** PRESS ANY KEY TO EXIT GALAXIS ***"
    WHILE INKEY$=""
    WEND
    CLOSE
    CLOSES 1
    EDIT
  ENDIF
  REM vysledok je v tyzden% a d$(b&)
RETURN
REM ---------------------------------------------------------------------------
PROCEDURE sortsave
  CLS
  currentdateonscreen
  dday&=day&
  mmonth&=month&
  yyear%=year%
  REM VYPOCET DATUMCISLA AKTUALNEHO DATUMU
  REM (DATUMCISLO = poradove cislo dna od roku 0) A POTOM SA VYTRIEDI A VYPISE
  IF FRAC(yyear%/4)=0
    m&(2)=29
  ELSE
    m&(2)=28
  ENDIF
  CLR dni&
  FOR n&=1 TO PRED(mmonth&)
    ADD dni&,m&(n&)
  NEXT n&
  ADD dni&,dday&
  dnesnedatumcislo%=ADD(dni&,ADD(MUL(365,PRED(yyear%)),TRUNC((PRED(yyear%))/4)))
  REM VYPOCET CISLA POSLEDNEHO TESTOVANEHO DATUMU
  konecnedatumcislo%=ADD(dnesnedatumcislo%,PRED(numb%))
  REM VYPOCET CISLA 31.12 AKTUALNEHO ROKA
  CLR dni&
  FOR n&=1 TO 12
    ADD dni&,m&(n&)
  NEXT n&
  datumcislo3112%=ADD(dni&,ADD(MUL(365,PRED(yyear%)),TRUNC((PRED(yyear%))/4)))
  PRINT AT(6,5);"Done ";AT(15,5);" of total ";bloch&;" items"
  poradie%=-1
  itemfirstpredosly%=1
  REM pripocet% BUDE ZA DO-LOOP OBSAHOVAT POCET PRESKOCENYCH 29.2 S NEPRESTUPNYM
  REM ROKOM - TREBA HO PRIPOCITAT K poradie%, LEBO TO SA DEKREMENTOVALO A TIEZ
  REM PRESKOCENYCH KED SA NEVYPISOVALI ANNUAL ITEMs
  CLR pripocet%
  FOR nx%=1 TO riadky%
    IF slava$(nx%)=""
      INC poradie%
      PRINT AT(11,5);SUCC(poradie%)
      REM ------------MAMDA$-----------
      REM TERAZ SA VYEXTRAHUJE DATUM POLOZKY A VYPOCITA DATUMCISLO
      INC nx%
      REM itemfirst%(poradie%) ukazuje na zaciatok itemu, na jeho datum
      itemfirst%(poradie%)=nx%
      pozn!=FALSE
      erste|=INSTR(slava$(nx%),".")
      day&=VAL(LEFT$(slava$(nx%),PRED(erste|)))
      zweite|=RINSTR(slava$(nx%),".")
      IF erste|=zweite|
        IF annual!=FALSE
          DEC poradie%
          INC pripocet%
          GOTO vezmidalsie
        ENDIF
        REM ZNAMENA ZE DRUHA BODKA NIE JE A ITEM JE TEDA ANNUAL
        pozn!=TRUE
        month&=VAL(RIGHT$(slava$(nx%),SUB(LEN(slava$(nx%)),erste|)))
        REM AKO ROK PRE ANNUAL ITEMY DAM AKTUALNY ROK, AK UZ ALE TEN DATUM V TOMTO ROKU BOL, IDE DO BUDUCEHO ROKA
        year%=yyear%
        IF FRAC(year%/4)=0
          m&(2)=29
        ELSE
          m&(2)=28
        ENDIF
        CLR dni&
        FOR n&=1 TO PRED(month&)
          ADD dni&,m&(n&)
        NEXT n&
        ADD dni&,day&
        datumcislo%(poradie%)=ADD(dni&,ADD(MUL(365,PRED(year%)),TRUNC((PRED(year%))/4)))
        IF dnesnedatumcislo%>datumcislo%(poradie%)
          INC year%
          IF FRAC(year%/4)=0
            m&(2)=29
          ELSE
            m&(2)=28
          ENDIF
          CLR dni&
          FOR n&=1 TO PRED(month&)
            ADD dni&,m&(n&)
          NEXT n&
          ADD dni&,day&
          datumcislo%(poradie%)=ADD(dni&,ADD(MUL(365,PRED(year%)),+TRUNC((PRED(year%))/4)))
        ENDIF
      ELSE
        REM ZNAMENA ZE SU DVE BODKY A ITEM JE PRE JEDEN PRESNY DATUM
        month&=VAL(MID$(slava$(nx%),SUCC(erste|),SUB(zweite|,erste|)))
        year%=VAL(RIGHT$(slava$(nx%),SUB(LEN(slava$(nx%)),zweite|)))
        IF FRAC(year%/4)=0
          m&(2)=29
        ELSE
          m&(2)=28
        ENDIF
        CLR dni&
        FOR n&=1 TO PRED(month&)
          ADD dni&,m&(n&)
        NEXT n&
        ADD dni&,day&
        datumcislo%(poradie%)=ADD(dni&,ADD(MUL(365,PRED(year%)),TRUNC((PRED(year%))/4)))
      ENDIF
      REM -------------------- TEST NA WRONGDATE -----------------------------
      REM VZNIKOL PROBLEM - PRI UKAZOVANI ANNUAL 29-2 SA OBJAVOVALO WRONGDATE
      REM ALE NASLEDUJUCE TRI AND-y V IF-e TO ODSTRANIA
      REM KED JE TEN DEN A NEPRESTUPNY ROK (WRONGDATE), TEN DEN SA JEDNODUCHO NEVYPISE,
      REM ALE NEZASTAVI SA BEH AKOBY TO BOLO CHYBNE ZADANIE, ALE LEN AK TO JE ANNUAL
      REM ITEM, TEDA pozn!=TRUE (TEDA -1)
      IF day&=29 AND month&=2 AND pozn!=TRUE AND FRAC(year%/4)<>0
        REM DEC poradie% je tu, aby sa posl. udaje (zac itemu, ...) zmazali
        REM A IDEME ODZNOVA (TENTO IF MUSI BYT TESNE PRED LOOP !!!)
        DEC poradie%
        INC pripocet%
        GOTO vezmidalsie
      ELSE IF day&=29 AND month&=2 AND pozn!=FALSE AND FRAC(year%/4)<>0
        PRINT AT(6,10);"DATE ";day&;".";month&;".";year%;" IS WRONG, CHANGE IT IN ADDRESSES.PBX FILE"
        PRINT AT(6,15);"*** PRESS ANY KEY TO EXIT GALAXIS ***"
        WHILE INKEY$=""
        WEND
        CLOSE
        CLOSES 1
        EDIT
      ENDIF
    ENDIF
    vezmidalsie:
  NEXT nx%
  REM TU JE PRINT AKO OPRAVA ZA PRESKOCENE ITEMY 29.2. S NEPRESTUPNYM ROKOM
  PRINT AT(11,5);ADD(SUCC(poradie%),pripocet%);" of total ";bloch&;" items";SPC(2)
  REM ----------- SLUCKA VYPISU NA OBRAZOVKU A DO SORTEDPLATYS.PBX ---------
  CLS
  OPEN "o",#2,"HDW:Super-Data/Words/NOTES/SORTEDPLATYS.PBX"
  PRINT AT(1,2);
  CLR predosledatumcislo%
  IF numb%<366
    CLR pocetrokov%
  ELSE
    pocetrokov%=PRED(TRUNC(numb%/366))
  ENDIF
  FOR gitara%=0 TO pocetrokov%
    FOR ja%=dnesnedatumcislo% TO konecnedatumcislo%
      FOR marus%=0 TO poradie%
        IF ja%=datumcislo%(marus%)
          exor%=itemfirst%(marus%)
          REM ------------SKRATENA MAMDA$-----------
          REM TERAZ SA LEN VYEXTRAHUJE DATUM POLOZKY - KVOLI weekday
          erste|=INSTR(slava$(exor%),".")
          day&=VAL(LEFT$(slava$(exor%),PRED(erste|)))
          zweite|=RINSTR(slava$(exor%),".")
          IF erste|=zweite|
            month&=VAL(RIGHT$(slava$(exor%),SUB(LEN(slava$(exor%)),erste|)))
            IF SUB(datumcislo%(marus%),dnesnedatumcislo%)<=SUB(datumcislo3112%,dnesnedatumcislo%)
              year%=ADD(yyear%,gitara%)
            ELSE
              year%=ADD(yyear%,SUCC(gitara%))
            ENDIF
          ELSE IF erste|<>zweite|
            IF gitara%>0
              GOTO pangamin
            ENDIF
            month&=VAL(MID$(slava$(exor%),SUCC(erste|),SUB(zweite|,erste|)))
            year%=VAL(RIGHT$(slava$(exor%),SUB(LEN(slava$(exor%)),zweite|)))
          ENDIF
          REM --------------------------------------
          weekday
          IF predosledatumcislo%<>datumcislo%(marus%)
            IF predosledatumcislo%<>0
              PRINT
              PRINT #2
            ENDIF
            spac|=3
            IF tyzden%>9
              spac|=4
            ENDIF
            PRINT #2;tyzden%;". ";d$(b&);" ";day&;".";month&;".";year%
            PRINT tyzden%;". ";d$(b&);" ";day&;".";month&;".";year%
          ENDIF
          DO
            INC exor%
            EXIT IF slava$(exor%)=""
            PRINT #2,SPC(spac|);slava$(exor%)
            PRINT SPC(spac|);slava$(exor%)
            EXIT IF exor%=SUCC(riadky%)
          LOOP
          predosledatumcislo%=datumcislo%(marus%)
        ENDIF
        pangamin:
      NEXT marus%
    NEXT ja%
  NEXT gitara%
  REM --------------------------------------------------------------------
  PRINT
  PRINT
  PRINT SPC(9);"*** PRESS ANY KEY TO RETURN TO THE MAIN MENU ***"
  CLOSE #2
  FRONTS 1
  WHILE INKEY$=""
  WEND
  day&=dday&
  month&=mmonth&
  year%=yyear%
RETURN
REM ---------------------------------------------------------------------------
PROCEDURE solarsystem
  CLS
  TITLEW #1," SOLAR SYSTEM"
  REM TU ZACINA PROGRAM KRESLENIA PLANET
  REM 25.12.1993
  REM Vychodna zemepisna dlzka Poprad (IBA MOJ ODHAD) 23 stupnov (teda
  REM v hodinach je to (23/360)*24, v sekundach (23/360)*24*3600
  REM Severna zemepisna sirka Poprad (IBA MOJ ODHAD) 49 stupnov
  REM Miestny hviezdny cas TH:
  REM - S0 = zdanlivy hviezdny cas na Greenwich poludniku (v tabulkach slnka)
  REM - T = pasmovy cas
  REM - LAMBDAP = z. dlzka daneho miesta, v hodinach, kladne sem od Greenwicha
  REM - LAMBDA
  DEFMOUSE 3
  stredx=319
  stredy=127
  REM PCIRCLE 20,20,11
  REM OPEN "i",#1,"vd0:tina.bob.pal"
  REM FOR v&=0 TO PRED(LOF(#1)/2)
  REM BGET #1,V:c&,2
  REM SETCOLOR v&,c&
  REM NEXT v&
  REM CLOSE #1
  OPEN "i",#1,"vd0:tina.bob"
  s$=INPUT$(LOF(#1),#1)
  MID$(s$,22,1)=CHR$(255)
  OBJECT.SHAPE 2,s$
  CLOSE #1
  CLR u
  CLR v
  DEFFILL 1,3
  CIRCLE stredx,stredy,250
  FILL stredx,stredy
  OBJECT.CLIP 0,0,640,256
  OBJECT.VX 2,100
  OBJECT.VY 2,100
  FOR x=0 TO 360 STEP 0.07
    OBJECT.OFF
    a=SIN(x)*100+stredx
    b=(COS(x)+0.2)*100++stredy
    OBJECT.X 2,a
    OBJECT.Y 2,b
    OBJECT.ON
  NEXT x
  STOP
  DO
    x$=INKEY$
    IF x$="4"
      OBJECT.OFF
      SUB u,5
      OBJECT.X 2,u
      OBJECT.ON
    ELSE IF x$="6"
      OBJECT.OFF
      ADD u,5
      OBJECT.X 2,u
      OBJECT.ON
    ELSE IF x$="8"
      OBJECT.OFF
      SUB v,5
      OBJECT.Y 2,v
      OBJECT.ON
    ELSE IF x$="2"
      OBJECT.OFF
      ADD v,5
      OBJECT.Y 2,v
      OBJECT.ON
    ENDIF
  LOOP
  STOP
  REM ------------------- TU JE DEMO2, VYMAZAT HNED AKO NEPOTREBNE ---
  ' Load the palette and set the colors properly
  OPEN "i",#1,"df0:bobs/demo.pal"
  FOR v&=0 TO PRED(LOF(#1)/2)
    BGET #1,V:c&,2
    SETCOLOR v&,c&
  NEXT v&
  CLOSE #1
  ' load a bob: (green magician)
  OPEN "i",#1,"df0:bobs/magic.bob"
  s$=INPUT$(LOF(#1),#1)
  MID$(s$,22,1)=CHR$(8)
  OBJECT.SHAPE 2,s$
  CLOSE #1
  MID$(s$,22,1)=CHR$(16)
  OBJECT.SHAPE 3,s$ ! blue magician
  OBJECT.PLANES 2
  ' use OBJECT.PLANES to change the color (plane 1 filled with 0`s)
  OBJECT.PLANES 3,29,0
  OBJECT.X 3,300
  OBJECT.Y 3,100
  OBJECT.VX 3,-100
  OBJECT.PRIORITY 3,10 ! blue mag. in front
  OBJECT.PRIORITY 2,20 ! green mag.
  ' set clipping
  OBJECT.CLIP 0,0,600,240
  OBJECT.ON
  OBJECT.START
  TITLEW #1,"Waiting for space..."
  WHILE INKEY$<>" "
    OBJECT.X 2,MOUSEX
    OBJECT.Y 2,MOUSEY
  WEND
  OBJECT.STOP
  OBJECT.CLOSE
  CLOSES 1
RETURN
PROCEDURE chester
  LOCAL toggle|,ink$,bhaho$,ahaho$,pass$,passlen|,x|,x%,xx%,ahalen%,chester&
  CLS
  REM THE CHESTER ENCRYPTOR
  REM 3. SEPTEMBER 1994 (Tomas J. Fulopp, +42 - (0)92 - 32814)
  TITLEW #1,"CHESTER by Tomas J. Fulopp, September 3rd, 1994"
  PRINT AT(3,3);"HIT SPACE TO SELECT, ENTER TO CONTINUE :"
  CLR toggle|
  PRINT AT(3,5);"- CIPHER A FILE -"
  DO
    ink$=INKEY$
    EXIT IF ink$=CHR$(13)
    IF ink$=CHR$(32)
      IF toggle|=0
        toggle|=1
        PRINT AT(3,5);"- CIPHER OUT A FILE -"
      ELSE
        CLR toggle|
        PRINT AT(3,5);"- CIPHER A FILE -";SPC(5)
      ENDIF
    ENDIF
  LOOP
  IF toggle|=0
    FILESELECT "Select NORMAL Ascii File","OK","HDW:Super-Data/Words/",ahaho$
    IF RIGHT$(ahaho$,4)=".CHE"
      CLS
      PRINT AT(10,10);"IMPOSSIBLE TO CIPHER CIPHERED !!!"
      DELAY 7
      GOTO salon
    ENDIF
  ELSE
    FILESELECT "Select CIPHERED Ascii File","OK","HDW:Super-Data/Words/",ahaho$
    IF RIGHT$(ahaho$,4)<>".CHE"
      CLS
      PRINT AT(10,10);"IMPOSSIBLE TO UNCIPHER UNCIPHERED !!!"
      DELAY 7
      GOTO salon
    ENDIF
  ENDIF
  OPEN "i",#77,ahaho$
  IF LOF(#77)=0
    CLS
    PRINT AT(10,10);"THIS FILE HAS ZERO LENGTH !!!"
    DELAY 7
    CLOSE #77
    GOTO salon
  ELSE
    CLOSE #77
  ENDIF
  PRINT AT(3,8);"OLD FILE: ";ahaho$
  IF toggle|=1
    PRINT AT(3,13);"PASSWORD: ";
    FORM INPUT 255,pass$
  ELSE
    pass$="Danica"
  ENDIF
  byk&=LEN(pass$)
  PRINT AT(13,13);SPC(byk&)
  passlen|=LEN(pass$)
  FOR x|=1 TO passlen|
    pass|(x|)=ASC(MID$(pass$,x|,1))
  NEXT x|
  OPEN "i",#77,ahaho$
  IF toggle|=0
    bhaho$=RIGHT$(ahaho$,LEN(ahaho$))+".CHE"
  ELSE
    bhaho$=LEFT$(ahaho$,SUB(LEN(ahaho$),4))
  ENDIF
  PRINT AT(3,10);"NEW FILE: ";bhaho$
  OPEN "o",#78,bhaho$
  ahalen%=LOF(#77)
  PRINT AT(3,20);"PROCESSING ";ahalen%;" BYTES... ";
  IF toggle|=0
    CLR x|
    FOR x%=1 TO ahalen%
      INC x|
      IF x|>passlen|
        x|=1
      ENDIF
      chester&=ADD(INP(#77),pass|(x|))
      IF chester&>255
        SUB chester&,255
      ENDIF
      OUT #78,chester&
    NEXT x%
  ELSE
    CLR x|
    FOR x%=1 TO ahalen%
      INC x|
      IF x|>passlen|
        x|=1
      ENDIF
      chester&=SUB(INP(#77),pass|(x|))
      IF chester&<1
        ADD chester&,255
      ENDIF
      OUT #78,chester&
    NEXT x%
  ENDIF
  CLOSE #78
  CLOSE #77
  OPEN "i",#77,bhaho$
  xx%=LOF(#77)
  OPEN "o",#78,bhaho$+".bak"
  FOR x%=1 TO xx%
    x|=INP(#77)
    OUT #78,x|
  NEXT x%
  CLOSE #78
  CLOSE #77
  OPEN "o",#77,ahaho$
  CLOSE #77
  OPEN "o",#77,ahaho$+".bak"
  CLOSE #77
  PRINT "DONE ";
  DELAY 6
  PRINT "!!!"
  DELAY 1
  salon:
RETURN
REM ---------------------------------------------------------------------------
REM ------------------ NASLEDUJU PROCEDURY TRANSFORMATOROV --------------------
PROCEDURE tomtrans
  CLS
  RESTORE t11
  LOCAL ahaho$,suffix$,zac,x&,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c!
  TITLEW #1," February 9, 1994 TOM --> TRANS "
  FILESELECT "Select TOM File","OK","DH3:",ahaho$
  suffix$="-TRANS"
  huh|=82
  zavertrans
RETURN
PROCEDURE transtom
  CLS
  RESTORE t11
  LOCAL ahaho$,suffix$,zac,x&,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c!
  TITLEW #1," February 9, 1994 TRANS --> TOM "
  FILESELECT "Select TRANS File","OK","DH3:",ahaho$
  suffix$="-TOM"
  huh|=82
  zavertrans2
  REM -------------------- BOD ZMENY
  t11:
  DATA $e3,$c5,$e9,$d3,$e1,$c3,$e8,$d2,$ee,$da,$dd,$d9,$e0,$c1,$e5,$c9,$e4,$d6
  DATA $eb,$d5,$a4,$c6,$ec,$ca,$b8,$d1,$aa,$cb,$ac,$cc,$d4,$c0,$c3,$e5,$c9,$f3
  DATA $c1,$e3,$c8,$f2,$ce,$fa,$cd,$f9,$c0,$e1,$c5,$e9,$c4,$f6,$cb,$f5,$a5,$e6
  DATA $cc,$ea,$b7,$f1,$ab,$eb,$ad,$ec,$d7,$e0,$c2,$e4,$ca,$f4,$c6,$ee,$c7,$ef
  DATA $e2,$c4,$ea,$d4,$e6,$ce,$e7,$cf,160,32
  REM ------------------------------
  REM KONIEC
RETURN
PROCEDURE tomkoi
  CLS
  RESTORE t22
  LOCAL ahaho$,suffix$,zac,x&,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c!
  TITLEW #1," February 9, 1994 TOM --> KOI "
  FILESELECT "Select TOM File","OK","DH3:",ahaho$
  suffix$="-KOI"
  huh|=86
  zavertrans
RETURN
PROCEDURE koitom
  CLS
  RESTORE t22
  LOCAL ahaho$,suffix$,zac,x&,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c!
  TITLEW #1," February 9, 1994 KOI --> TOM "
  FILESELECT "Select KOI File","OK","DH3:",ahaho$
  suffix$="-TOM"
  huh|=86
  zavertrans2
  REM -------------------- BOD ZMENY
  t22:
  DATA $a4,$c6,$a5,$e6,$aa,$cb,$ab,$eb,$ac,$cc,$ad,$ec,$af,$b1,$b1,$b9,$b4,$ba
  DATA $b7,$f1,$b8,$d1,$c0,$e1,$c1,$e3,$c2,$e4,$c3,$e5,$c4,$f7,$c5,$e9,$c6,$ee
  DATA $c7,$ef,$c8,$f2,$c9,$f3,$ca,$f4,$cb,$f5,$cc,$ea,$cd,$f9,$ce,$fa,$d4,$d0
  DATA $d7,$f0,$dd,$d9,$e0,$c1,$e1,$c3,$e2,$c4,$e3,$c5,$e4,$d7,$e5,$c9,$e6,$ce
  DATA $e7,$cf,$e8,$d2,$e9,$d3,$ea,$d4,$eb,$d5,$ec,$ca,$ee,$da
  REM ------------------------------
  REM KONIEC
RETURN
PROCEDURE tomtwig
  CLS
  RESTORE t33
  LOCAL ahaho$,suffix$,zac,x&,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c!
  TITLEW #1," February 9, 1994 TOM --> TWIG "
  FILESELECT "Select TOM File","OK","DH3:",ahaho$
  suffix$="-TWIG"
  huh|=62
  zavertrans
RETURN
PROCEDURE twigtom
  CLS
  RESTORE t33
  LOCAL ahaho$,suffix$,zac,x&,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c!
  TITLEW #1," February 9, 1994 TWIG --> TOM "
  FILESELECT "Select TWIG File","OK","DH3:",ahaho$
  suffix$="-TOM"
  huh|=62
  zavertrans2
  REM -------------------- BOD ZMENY
  t33:
  DATA $60,$e8,$e2,$40,$e3,$5b,$e9,$7b,$e1,$3e,$e8,$60,$ee,$2a,$dd,$28,$e0,$3c
  DATA $e5,$5d,$e4,$26,$7e,$eb,$2a,$ee,$5f,$e7,$eb,$7e,$e7,$5f,$5b,$e3,$5d,$e5
  DATA $26,$e4,$28,$dd,$40,$e2,$ea,$7d,$ec,$7f,$ac,$23,$e6,$5e,$23,$ac,$3c,$e0
  DATA $3e,$e1,$5e,$e6,$7b,$e9,$7d,$ea
  REM ------------------------------
  REM KONIEC
RETURN
PROCEDURE pbxkoi
  CLS
  RESTORE t44
  LOCAL ahaho$,suffix$,zac,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s
  TITLEW #1," January 23, 1996 PBX --> KOI "
  FILESELECT "Select PBX File","OK","DH3:",ahaho$
  suffix$="-KOI"
  huh|=82
  zavertrans
RETURN
PROCEDURE koipbx
  CLS
  RESTORE t44
  LOCAL ahaho$,suffix$,zac,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s
  TITLEW #1," January 23, 1996 KOI --> PBX "
  FILESELECT "Select KOI File","OK","DH3:",ahaho$
  suffix$="-PBX"
  huh|=82
  zavertrans2
  REM -------------------- BOD ZMENY
  t44:
  DATA $c1,$e1,$c4,$f1,$c7,$e3,$c8,$e4,$c9,$f7,$ca,$e5,$cd,$e9,$ce,$ec,$cf,$eb
  DATA $d0,$f2,$d1,$ee,$d3,$ef,$d4,$f0,$d5,$e6,$d6,$ed,$d7,$f3,$d9,$f4,$da,$f5
  DATA $db,$ea,$dd,$f9,$de,$fa,$e1,$c1,$e4,$d1,$e7,$c3,$e8,$c4,$e9,$d7,$ea,$c5
  DATA $ed,$c9,$ee,$cc,$ef,$cb,$f0,$d2,$f1,$ce,$f3,$cf,$f4,$d0,$f5,$c6,$f7,$d3
  DATA $f9,$d4,$fa,$d5,$fb,$ca,$fd,$d9,$fe,$da
  REM ------------------------------
  REM KONIEC
RETURN
PROCEDURE zavertrans
  zac=TIMER
  FOR t|=1 TO huh|
    READ john|(t|)
  NEXT t|
  PRINT AT(3,10);"Transformed characters: "
  PRINT AT(3,23);ahaho$
  PRINT AT(3,27);ahaho$+suffix$
  OPEN "i",#1,ahaho$
  OPEN "o",#2,ahaho$+suffix$
  lof=LOF(#1)
  PRINT AT(3,6);"Done ";AT(11,6);"% out of total ";lof;" bytes"
  DO
    slava|=INP(#1)
    REM ---------------------- BOD ZMENY
    FOR t|=1 TO huh| STEP 2
      IF slava|=john|(t|)
        slava|=john|(SUCC(t|))
        t|=huh|
        INC trans%
        perc|=INT((100*LOC(#1))/lof)
        IF perc|<>percst|
          PRINT AT(27,10);trans%;AT(8,6);perc|
          percst|=perc|
        ENDIF
      ENDIF
    NEXT t|
    OUT #2,slava|
    EXIT IF LOC(#1)>=lof
  LOOP
  PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
  CLOSE #2
  CLOSE #1
  kon=TIMER
  FRONTS 1
  tim=(kon-zac)/200
  h=TRUNC(tim/3600)
  m=TRUNC(FRAC(tim/3600)*60)
  s=INT(FRAC(FRAC(tim/3600)*60)*60)
  PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
  PRINT AT(3,18);"SAVING ..."
  DELAY 5
RETURN
PROCEDURE zavertrans2
  zac=TIMER
  FOR t|=1 TO huh|
    READ john|(t|)
  NEXT t|
  PRINT AT(3,10);"Transformed characters: "
  PRINT AT(3,23);ahaho$
  PRINT AT(3,27);ahaho$+suffix$
  OPEN "i",#1,ahaho$
  OPEN "o",#2,ahaho$+suffix$
  lof=LOF(#1)
  PRINT AT(3,6);"Done ";AT(11,6);"% out of total ";lof;" bytes"
  DO
    slava|=INP(#1)
    REM ---------------------- BOD ZMENY
    FOR t|=2 TO huh| STEP 2
      IF slava|=john|(t|)
        slava|=john|(PRED(t|))
        t|=huh|
        INC trans%
        perc|=INT((100*LOC(#1))/lof)
        IF perc|<>percst|
          PRINT AT(27,10);trans%;AT(8,6);perc|
          percst|=perc|
        ENDIF
      ENDIF
    NEXT t|
    OUT #2,slava|
    EXIT IF LOC(#1)>=lof
  LOOP
  PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
  CLOSE #2
  CLOSE #1
  kon=TIMER
  FRONTS 1
  tim=(kon-zac)/200
  h=TRUNC(tim/3600)
  m=TRUNC(FRAC(tim/3600)*60)
  s=INT(FRAC(FRAC(tim/3600)*60)*60)
  PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
  PRINT AT(3,18);"SAVING ..."
  DELAY 5
RETURN
REM ---------------------------------------------------------------------------
PROCEDURE pbxtrans
  REM pbxkoi
  CLS
  RESTORE t44
  LOCAL ahaho$,suffix$,zac,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c|
  TITLEW #1," January 23, 1996 PBX --> TRANS "
  FILESELECT "Select PBX File","OK","DH3:",ahaho$
  c|=1
  huh|=82
  zac=TIMER
  zavertransplus
  CLS
  REM koitom
  RESTORE t22
  c|=2
  huh|=86
  zavertransplus2
  CLS
  REM tomtrans
  RESTORE t11
  suffix$="-TRANS"
  c|=3
  huh|=82
  zavertransplus
  kon=TIMER
  FRONTS 1
  tim=(kon-zac)/200
  h=TRUNC(tim/3600)
  m=TRUNC(FRAC(tim/3600)*60)
  s=INT(FRAC(FRAC(tim/3600)*60)*60)
  PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
  PRINT AT(3,18);"SAVING ..."
  DELAY 5
RETURN
PROCEDURE transpbx
  REM transtom
  CLS
  RESTORE t11
  LOCAL ahaho$,suffix$,zac,t|,lof
  LOCAL slava|,trans%,kon,tim,h,m,s,c|
  TITLEW #1," January 23, 1996 TRANS --> PBX "
  FILESELECT "Select TRANS File","OK","DH3:",ahaho$
  c|=1
  huh|=82
  zac=TIMER
  zavertransplus2
  CLS
  REM tomkoi
  RESTORE t22
  c|=2
  huh|=86
  zavertransplus
  CLS
  REM koipbx
  RESTORE t44
  suffix$="-PBX"
  c|=3
  huh|=82
  zavertransplus2
  kon=TIMER
  FRONTS 1
  tim=(kon-zac)/200
  h=TRUNC(tim/3600)
  m=TRUNC(FRAC(tim/3600)*60)
  s=INT(FRAC(FRAC(tim/3600)*60)*60)
  PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
  PRINT AT(3,18);"SAVING ..."
  DELAY 5
RETURN
PROCEDURE zavertransplus
  FOR t|=1 TO huh|
    READ john|(t|)
  NEXT t|
  PRINT AT(3,10);"Transformed characters: "
  IF c|=1
    OPEN "i",#1,ahaho$
    OPEN "o",#2,"RAM:HELP"
    PRINT AT(3,23);ahaho$
    PRINT AT(3,27);"RAM:HELP"
  ELSE IF c|=2
    OPEN "i",#1,"RAM:HELP"
    OPEN "o",#2,"RAM:HELP2"
    PRINT AT(3,23);"RAM:HELP"
    PRINT AT(3,27);"RAM:HELP2"
  ELSE IF c|=3
    OPEN "i",#1,"RAM:HELP2"
    OPEN "o",#2,ahaho$+suffix$
    PRINT AT(3,23);"RAM:HELP2"
    PRINT AT(3,27);ahaho$+suffix$
  ENDIF
  lof=LOF(#1)
  PRINT AT(3,6);"Done % out of total ";lof;" bytes"
  DO
    slava|=INP(#1)
    REM ---------------------- BOD ZMENY
    FOR t|=1 TO huh| STEP 2
      IF slava|=john|(t|)
        slava|=john|(SUCC(t|))
        t|=huh|
        INC trans%
        perc|=INT((100*LOC(#1))/lof)
        IF perc|<>percst|
          PRINT AT(27,10);trans%;AT(8,6);perc|
          percst|=perc|
        ENDIF
      ENDIF
    NEXT t|
    OUT #2,slava|
    EXIT IF LOC(#1)>=lof
  LOOP
  PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
  CLOSE #2
  CLOSE #1
RETURN
PROCEDURE zavertransplus2
  FOR t|=1 TO huh|
    READ john|(t|)
  NEXT t|
  PRINT AT(3,10);"Transformed characters: "
  IF c|=1
    OPEN "i",#1,ahaho$
    OPEN "o",#2,"RAM:HELP"
    PRINT AT(3,23);ahaho$
    PRINT AT(3,27);"RAM:HELP"
  ELSE IF c|=2
    OPEN "i",#1,"RAM:HELP"
    OPEN "o",#2,"RAM:HELP2"
    PRINT AT(3,23);"RAM:HELP"
    PRINT AT(3,27);"RAM:HELP2"
  ELSE IF c|=3
    OPEN "i",#1,"RAM:HELP2"
    OPEN "o",#2,ahaho$+suffix$
    PRINT AT(3,23);"RAM:HELP2"
    PRINT AT(3,27);ahaho$+suffix$
  ENDIF
  lof=LOF(#1)
  PRINT AT(3,6);"Done % out of total ";lof;" bytes"
  DO
    slava|=INP(#1)
    REM ---------------------- BOD ZMENY
    FOR t|=2 TO huh| STEP 2
      IF slava|=john|(t|)
        slava|=john|(PRED(t|))
        t|=huh|
        INC trans%
        perc|=INT((100*LOC(#1))/lof)
        IF perc|<>percst|
          PRINT AT(27,10);trans%;AT(8,6);perc|
          percst|=perc|
        ENDIF
      ENDIF
    NEXT t|
    OUT #2,slava|
    EXIT IF LOC(#1)>=lof
  LOOP
  PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
  CLOSE #2
  CLOSE #1
RETURN
REM ---------------------------------------------------------------------------
REM ZA TYMTO RIADKOM BUDU SPOCIVAT VSETKY DATA
REM ---------------------------------------------------------------------------
kalendar:
DATA "MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY"
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DATA 1,6,5,4,3,1,7,6,5,3,2,1,7,5,4,3,2,7,6,5,4,2,1,7,6,4,3,2
REM ---------------------------------------------------------------------------


	A look at Galaxis running in my Amiga


	And this is the source code of Galaxis in GFA Basic

Login or register to post comments

WikiTree

See Vacilando's very successful open source project, WikiTree.org!

Tomáš J. Fülöpp

Login or register to post comments

Fraktály Benoita Mandelbrota

Program generujúci fraktály Mandelbrotovej množiny, napísaný pre Commodore Amiga v jazyku GFA Basic.

Publikované v Amiga, měsíčník pro uživatele počítačů amiga č. 6, 1992, str. 18, 21-22, vyd. Jiří Prózr, Praha, ČSFR.

1992_mandelbrot

Login or register to post comments

TrailScout

TrailScout - the intuitive breadcrumb system for Drupal - simply showing the last few recently visited pages!

Get it here.

A breeze to install and run; try it out (just don't forget to enable user access permissions).

I'll add more info and description of properties, advantages and disadvantages, future plans, etc. very soon.

Tomáš J. Fülöpp

Login or register to post comments

Hypergraph

Integration of Java hyperbolic tree geometry visualization developed at http://hypergraph.sourceforge.net/ in a Drupal module. >> Download the Hypergraph Drupal module. << Don't get scared by the words and play with the demo below. (Hold the left mouse button to pan the graph!) Hypergraph is not only beautiful, but also conceptually a very clever beast; enormously useful for site navigation.

Brilliant Gallery

[get_slashbgfromdrupal]

Tomáš J. Fülöpp

Step-by-step installation:

Read more

Navigation