RBBS port to the C128

Started by Blacklord, August 14, 2026, 08:09 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Blacklord

One of the things I've always wanted to do is write a BBS for theC128 (several years ago we had a thread about this). So - I've started porting a CP/M version of RBBs (3.7 from 1981) over.

It's going to be heavily customised :

Although it will run on a real 128, the software is written to run under VICE (on Windows)

It has a custom tcp server (TCPSRV.EXE), utilises Swiftlink emulation, CMD hard disk emulation, JiffyDOS ROMS.

As I complete a task I'll update here.


Blacklord

Interim code for tcpsrv.c (compiles under Microsoft Visual Studio 2026):

/*
 * tcpsrv.c
 *
 * RBBS-128 TCP/VICE communications bridge.
 *
 * Port 23232:
 *     VICE X128 / SwiftLink connection
 *
 * Port 6400:
 *     Incoming BBS caller connection
 *
 * Data flow:
 *
 *     Caller <----> TCPSRV <----> X128
 *
 * Internal control messages sent only to X128:
 *
 *     #CONNECT
 *     #TIME:DD/MM/YYYY HH:MM:SS
 *     #DISCONNECT
 *
 * Internal control messages are deliberately sent more
 * slowly than normal caller traffic because BASIC is
 * polling the emulated 6551 ACIA one character at a time.
 *
 * Usage:
 *
 *     tcpsrv.exe
 */

#define WIN32_LEAN_AND_MEAN

#include <windows.h>
#include <winsock2.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <conio.h>

#pragma comment(lib, "Ws2_32.lib")

#define X128_PORT       23232
#define CALLER_PORT      6400
#define BUFFER_SIZE      4096

#define INVALID_CLIENT INVALID_SOCKET


/*
 * Send an entire buffer without pacing.
 *
 * Used for normal TCP destinations such as the caller.
 */
static int send_all(SOCKET socket,
                    const char *buffer,
                    int length)
{
    int total;
    int sent;

    total = 0;

    while (total < length)
    {
        sent = send(socket,
                    buffer + total,
                    length - total,
                    0);

        if (sent == SOCKET_ERROR)
        {
            return SOCKET_ERROR;
        }

        if (sent == 0)
        {
            return 0;
        }

        total += sent;
    }

    return total;
}


/*
 * Send a zero-terminated string without pacing.
 */
static int send_text(SOCKET socket,
                     const char *text)
{
    return send_all(socket,
                    text,
                    (int)strlen(text));
}


/*
 * Send ordinary caller/console data to the C128.
 *
 * 10 ms pacing is used so a pasted line is not dumped
 * into the emulated ACIA in one instantaneous TCP burst.
 */
static int send_to_x128(SOCKET socket,
                        const char *buffer,
                        int length)
{
    int i;
    int result;

    for (i = 0; i < length; i++)
    {
        result = send(socket,
                      buffer + i,
                      1,
                      0);

        if (result == SOCKET_ERROR)
        {
            return SOCKET_ERROR;
        }

        if (result == 0)
        {
            return 0;
        }

        Sleep(50);
    }

    return length;
}


/*
 * Send internal TCPSRV control messages to the C128.
 *
 * These are deliberately much slower than caller data
 * while we prove reliable reception in BASIC.
 */
static int send_control_to_x128(SOCKET socket,
                                const char *buffer,
                                int length)
{
    int i;
    int result;

    for (i = 0; i < length; i++)
    {
        result = send(socket,
                      buffer + i,
                      1,
                      0);

        if (result == SOCKET_ERROR)
        {
            return SOCKET_ERROR;
        }

        if (result == 0)
        {
            return 0;
        }

        /*
         * Conservative test value.
         * Reduce later once the real RBBS line reader
         * has been proven reliable.
         */
        Sleep(100);
    }

    return length;
}


/*
 * Generate host local date/time.
 *
 * Australian display order:
 *
 *     DD/MM/YYYY HH:MM:SS
 */
static void make_time_message(char *buffer,
                              size_t size)
{
    SYSTEMTIME st;

    GetLocalTime(&st);

    snprintf(buffer,
             size,
             "#TIME:%02u/%02u/%04u %02u:%02u:%02u\r\n",
             (unsigned int)st.wDay,
             (unsigned int)st.wMonth,
             (unsigned int)st.wYear,
             (unsigned int)st.wHour,
             (unsigned int)st.wMinute,
             (unsigned int)st.wSecond);
}


/*
 * Create a listening TCP socket.
 *
 * Both listeners currently bind to localhost only.
 */
static SOCKET create_listener(int port)
{
    SOCKET s;
    struct sockaddr_in address;
    int reuse;
    int result;

    s = socket(AF_INET,
               SOCK_STREAM,
               IPPROTO_TCP);

    if (s == INVALID_SOCKET)
    {
        return INVALID_SOCKET;
    }

    reuse = 1;

    setsockopt(s,
               SOL_SOCKET,
               SO_REUSEADDR,
               (const char *)&reuse,
               sizeof(reuse));

    ZeroMemory(&address,
               sizeof(address));

    address.sin_family = AF_INET;

    address.sin_addr.s_addr =
        htonl(INADDR_LOOPBACK);

    address.sin_port =
        htons((unsigned short)port);

    result = bind(s,
                  (struct sockaddr *)&address,
                  sizeof(address));

    if (result == SOCKET_ERROR)
    {
        closesocket(s);
        return INVALID_SOCKET;
    }

    result = listen(s,
                    4);

    if (result == SOCKET_ERROR)
    {
        closesocket(s);
        return INVALID_SOCKET;
    }

    return s;
}


/*
 * Tell the C128 that a caller has connected.
 *
 * Also send the current Windows host date/time.
 */
static int notify_connect(SOCKET x128Socket)
{
    SYSTEMTIME st;
    char message[128];

    GetLocalTime(&st);

    snprintf(message,
             sizeof(message),
             "#CONNECT:%02u/%02u/%04u %02u:%02u:%02u\r\n",
             (unsigned int)st.wDay,
             (unsigned int)st.wMonth,
             (unsigned int)st.wYear,
             (unsigned int)st.wHour,
             (unsigned int)st.wMinute,
             (unsigned int)st.wSecond);

    if (send_control_to_x128(x128Socket,
                             message,
                             (int)strlen(message))
        == SOCKET_ERROR)
    {
        return SOCKET_ERROR;
    }

    return 0;
}

/*
 * Tell the C128 that the caller disconnected.
 */
static void notify_disconnect(SOCKET x128Socket)
{
    const char *message =
        "#DISCONNECT\r\n";

    send_control_to_x128(x128Socket,
                         message,
                         (int)strlen(message));
}


/*
 * Reject an additional caller while one is online.
 */
static void reject_busy_caller(SOCKET socket)
{
    const char *message =
        "\r\n"
        "RBBS-128 is currently in use.\r\n"
        "Please try again later.\r\n";

    send_text(socket,
              message);

    shutdown(socket,
             SD_BOTH);

    closesocket(socket);
}


int main(void)
{
    WSADATA wsaData;

    SOCKET x128Listen;
    SOCKET callerListen;

    SOCKET x128Socket;
    SOCKET callerSocket;
    SOCKET newSocket;

    fd_set readSet;

    struct timeval timeout;

    unsigned char buffer[BUFFER_SIZE];

    int received;
    int result;

    unsigned char ch;


    /*
     * Initialize Winsock.
     */
    result = WSAStartup(MAKEWORD(2, 2),
                        &wsaData);

    if (result != 0)
    {
        fprintf(stderr,
                "tcpsrv: WSAStartup failed: %d\n",
                result);

        return 1;
    }


    /*
     * Create X128 listener.
     */
    x128Listen =
        create_listener(X128_PORT);

    if (x128Listen == INVALID_SOCKET)
    {
        fprintf(stderr,
                "tcpsrv: unable to listen on port %d: %d\n",
                X128_PORT,
                WSAGetLastError());

        WSACleanup();

        return 1;
    }


    /*
     * Create caller listener.
     */
    callerListen =
        create_listener(CALLER_PORT);

    if (callerListen == INVALID_SOCKET)
    {
        fprintf(stderr,
                "tcpsrv: unable to listen on port %d: %d\n",
                CALLER_PORT,
                WSAGetLastError());

        closesocket(x128Listen);
        WSACleanup();

        return 1;
    }


    fprintf(stderr,
            "tcpsrv: X128 listening on TCP port %d\n",
            X128_PORT);

    fprintf(stderr,
            "tcpsrv: callers listening on TCP port %d\n",
            CALLER_PORT);


    /*
     * Persistent server loop.
     *
     * If X128 disconnects, TCPSRV stays alive and waits
     * for X128 to reconnect.
     */
    for (;;)
    {
        /*
         * Wait for VICE/X128.
         */
        x128Socket =
            accept(x128Listen,
                   NULL,
                   NULL);

        if (x128Socket == INVALID_SOCKET)
        {
            fprintf(stderr,
                    "tcpsrv: X128 accept failed: %d\n",
                    WSAGetLastError());

            break;
        }

        fprintf(stderr,
                "tcpsrv: X128 connected\n");

        callerSocket = INVALID_CLIENT;


        /*
         * Service X128 and caller connections.
         */
        for (;;)
        {
            FD_ZERO(&readSet);

            FD_SET(x128Socket,
                   &readSet);

            FD_SET(callerListen,
                   &readSet);

            if (callerSocket != INVALID_CLIENT)
            {
                FD_SET(callerSocket,
                       &readSet);
            }


            /*
             * Short timeout allows Windows console
             * keyboard polling.
             */
            timeout.tv_sec = 0;
            timeout.tv_usec = 50000;


            result =
                select(0,
                       &readSet,
                       NULL,
                       NULL,
                       &timeout);

            if (result == SOCKET_ERROR)
            {
                fprintf(stderr,
                        "tcpsrv: select failed: %d\n",
                        WSAGetLastError());

                break;
            }


            /*
             * Incoming BBS caller.
             */
            if (FD_ISSET(callerListen,
                         &readSet))
            {
                newSocket =
                    accept(callerListen,
                           NULL,
                           NULL);

                if (newSocket != INVALID_SOCKET)
                {
                    if (callerSocket != INVALID_CLIENT)
                    {
                        reject_busy_caller(newSocket);
                    }
                    else
                    {
                        callerSocket = newSocket;

                        fprintf(stderr,
                                "tcpsrv: caller connected\n");


                        /*
                         * Signal carrier and provide
                         * date/time to RBBS-128.
                         */
                        if (notify_connect(x128Socket)
                            == SOCKET_ERROR)
                        {
                            fprintf(stderr,
                                    "tcpsrv: lost X128 while notifying connection\n");

                            break;
                        }
                    }
                }
            }


            /*
             * X128 -> local console and caller.
             */
            if (FD_ISSET(x128Socket,
                         &readSet))
            {
                received =
                    recv(x128Socket,
                         (char *)buffer,
                         sizeof(buffer),
                         0);

                if (received == 0)
                {
                    fprintf(stderr,
                            "tcpsrv: X128 disconnected\n");

                    break;
                }

                if (received == SOCKET_ERROR)
                {
                    fprintf(stderr,
                            "tcpsrv: X128 recv failed: %d\n",
                            WSAGetLastError());

                    break;
                }


                /*
                 * Always show C128 output locally.
                 */
                fwrite(buffer,
                       1,
                       received,
                       stdout);

                fflush(stdout);


                /*
                 * Forward C128 output to the caller.
                 */
                if (callerSocket != INVALID_CLIENT)
                {
                    if (send_all(callerSocket,
                                 (const char *)buffer,
                                 received)
                        == SOCKET_ERROR)
                    {
                        fprintf(stderr,
                                "tcpsrv: caller send failed\n");

                        shutdown(callerSocket,
                                 SD_BOTH);

                        closesocket(callerSocket);

                        callerSocket =
                            INVALID_CLIENT;

                        notify_disconnect(x128Socket);

                        fprintf(stderr,
                                "tcpsrv: caller disconnected\n");
                    }
                }
            }


            /*
             * Caller -> X128.
             */
            if (callerSocket != INVALID_CLIENT &&
                FD_ISSET(callerSocket,
                         &readSet))
            {
                received =
                    recv(callerSocket,
                         (char *)buffer,
                         sizeof(buffer),
                         0);

                if (received == 0)
                {
                    /*
                     * Normal caller disconnect.
                     */
                    shutdown(callerSocket,
                             SD_BOTH);

                    closesocket(callerSocket);

                    callerSocket =
                        INVALID_CLIENT;

                    notify_disconnect(x128Socket);

                    fprintf(stderr,
                            "tcpsrv: caller disconnected\n");
                }
                else if (received == SOCKET_ERROR)
                {
                    /*
                     * Abnormal caller disconnect.
                     */
                    shutdown(callerSocket,
                             SD_BOTH);

                    closesocket(callerSocket);

                    callerSocket =
                        INVALID_CLIENT;

                    notify_disconnect(x128Socket);

                    fprintf(stderr,
                            "tcpsrv: caller connection lost\n");
                }
                else
                {
                    /*
                     * Ordinary caller data uses the
                     * faster 10 ms pacing.
                     */
                    if (send_to_x128(x128Socket,
                                     (const char *)buffer,
                                     received)
                        == SOCKET_ERROR)
                    {
                        fprintf(stderr,
                                "tcpsrv: X128 send failed\n");

                        break;
                    }
                }
            }


            /*
             * Windows console keyboard -> X128.
             *
             * Retained for development and future
             * SYSOP use.
             */
            while (_kbhit())
            {
                ch =
                    (unsigned char)_getch();


                /*
                 * Ignore Windows extended keys.
                 */
                if (ch == 0 || ch == 224)
                {
                    if (_kbhit())
                    {
                        (void)_getch();
                    }

                    continue;
                }


                /*
                 * Console input uses normal 10 ms
                 * C128 pacing.
                 */
                if (send_to_x128(x128Socket,
                                 (const char *)&ch,
                                 1)
                    == SOCKET_ERROR)
                {
                    fprintf(stderr,
                            "tcpsrv: X128 keyboard send failed\n");

                    break;
                }
            }
        }


        /*
         * Clean up caller if still connected.
         */
        if (callerSocket != INVALID_CLIENT)
        {
            shutdown(callerSocket,
                     SD_BOTH);

            closesocket(callerSocket);

            callerSocket =
                INVALID_CLIENT;
        }


        /*
         * Clean up X128 connection.
         */
        shutdown(x128Socket,
                 SD_BOTH);

        closesocket(x128Socket);


        /*
         * Stay alive and wait for X128 again.
         */
        fprintf(stderr,
                "tcpsrv: waiting for X128\n");
    }


    /*
     * Final shutdown.
     */
    closesocket(callerListen);
    closesocket(x128Listen);

    WSACleanup();

    return 0;
}

Blacklord

Diffs to the original 1981 (v3.7) CP/M version so far :

16 message areas (the original had 1), private messages removed to their own message base rather than having one large, monolithic message base.

Blacklord

Interim code (15/8/2026) (WIP)

10 rem rbbs-128 1.0 main program
20 da=56832:sa=56833:ca=56834:ta=56835
30 sd=8:dd=9:fd=10
40 fast
45 dim m(200,2),ms$(10),ya$(16),ys$(16),ym$(16),yt$(16)
50 graphic 5
60 poke ta,30:poke ca,11
62 c1$=chr$(35)+chr$(67)+chr$(79)+chr$(78)+chr$(78)+chr$(69)+chr$(67)+chr$(84)+chr$(58)
64 c3$=chr$(35)+chr$(68)+chr$(73)+chr$(83)+chr$(67)+chr$(79)+chr$(78)+chr$(78)+chr$(69)+chr$(67)+chr$(84)
70 scnclr
80 print "rbbs-128 1.0"
90 print
100 print "commodore 128 remote bulletin board v1.0"
110 print
120 gosub 8300:gosub 10200:goto 7000

1000 rem caller login
1010 ur=0:hm=0:mf$="":pw$="":ci$=""
1020 a1$="enter your first name: ":n=1:gosub 5040
1030 c=1:ml=20:gosub 5170
1040 if cd then goto 7900
1050 n$=b$
1060 if n$="" then 1020
1070 if n$<"a" or len(n$)=1 then 1020
1080 ck=0
1090 for ix=1 to len(n$)
1100 if mid$(n$,ix,1)=" " then ck=1
1110 next ix
1120 if ck=0 then 1150
1130 a$="please do not use spaces in your name":gosub 5040
1140 gosub 5040:goto 1020
1150 a1$="enter your last name:  ":n=1:gosub 5040
1160 c=1:ml=20:gosub 5170
1170 if cd then goto 7900
1180 o$=b$
1190 if o$="" then 1020
1200 if o$<"a" or len(o$)=1 then 1020
1210 ck=0
1220 for ix=1 to len(o$)
1230 if mid$(o$,ix,1)=" " then ck=1
1240 next ix
1250 if ck=0 then 1280
1260 a$="please do not use spaces in your name":gosub 5040
1270 gosub 5040:goto 1150
1280 a$="checking user file...":gosub 5040
1290 gosub 2000
1300 if ok=0 then 1400
1310 a1$="enter your password: ":n=1:gosub 5040
1320 c=2:ml=20:gosub 5170
1330 if cd then goto 7900
1340 if b$=pw$ then 1370
1350 a$="incorrect password":gosub 5040
1360 goto 1310
1370 a$="login accepted":gosub 5040
1380 a$="welcome "+n$+" "+o$:gosub 5040
1390 goto 1800

1400 rem new caller
1410 a$="new user registration":gosub 5040
1420 gosub 2200
1430 if cd then goto 7900
1440 if ok=0 then 1020
1450 a$="registration complete":gosub 5040
1460 a$="welcome "+n$+" "+o$:gosub 5040

1800 rem login complete
1810 lg=-1
1820 gosub 8700
1830 gosub 5040
1840 a$="you are caller number:"+str$(tc):gosub 5040
1850 a$="rbbs-128 login complete.":gosub 5040
1860 a$="date/time: "+dd$+"/"+mo$+"/"+yr$+" "+tm$:gosub 5040
1870 gosub 9000
1880 goto 4000

2000 rem check rel users file
2010 ok=0:pw$="":ci$="":hm=0:ur=0:mf$=""
2020 open 15,dd,15
2030 open 2,dd,2,"users"
2040 rn=1:gosub 8000:gosub 8100
2050 nu=val(r$)
2060 if nu<1 then 2160
2070 for ur=2 to nu+1
2080 rn=ur:gosub 8000:gosub 8100
2090 u$=mid$(r$,3)
2100 gosub 2700
2110 if f1$=n$ and f2$=o$ then 2140
2120 next ur
2130 goto 2160
2140 mf$=left$(r$,1)
2150 pw$=f4$:ci$=f3$:hm=val(f5$):ok=-1
2160 close 2
2170 close 15
2180 return

2200 rem new user registration
2210 ok=0
2220 a1$="city/state: ":n=1:gosub 5040
2230 c=1:ml=30:gosub 5170
2240 if cd then return
2250 ci$=b$
2260 if len(ci$)<2 then 2220
2270 a1$="choose a password: ":n=1:gosub 5040
2280 c=2:ml=20:gosub 5170
2290 if cd then return
2300 p1$=b$
2310 if len(p1$)<3 then 2270
2320 a1$="enter password again: ":n=1:gosub 5040
2330 c=2:ml=20:gosub 5170
2340 if cd then return
2350 if b$=p1$ then 2390
2360 a$="passwords do not match":gosub 5040
2370 gosub 5040
2380 goto 2270
2390 gosub 5040
2400 a$="name: "+n$+" "+o$:gosub 5040
2410 a$="city/state: "+ci$:gosub 5040
2420 a1$="is this correct (y/n)? ":n=1:gosub 5040
2430 c=1:ml=1:gosub 5170
2440 if cd then return
2450 if b$="" then 2420
2460 if asc(b$)=89 then 2500
2470 if asc(b$)=78 then 2220
2480 goto 2420

2500 rem append new rel user
2510 ok=0
2520 open 15,dd,15
2530 open 2,dd,2,"users"
2540 rn=1:gosub 8000:gosub 8100
2550 nu=val(r$)
2560 rn=nu+2:ur=rn
2570 gosub 8000
2580 r$="  "+n$+";"+o$+";"+ci$+";"+p1$+";0"
2590 gosub 8200
2600 rn=1:gosub 8000
2610 r$=str$(nu+1)
2620 gosub 8200
2630 close 2
2640 input#15,en,em$,et,es
2650 close 15
2660 if en<>0 then 2690
2670 pw$=p1$:hm=0:mf$=" ":ok=-1
2680 return
2690 a$="error writing users file":gosub 5040
2695 return

2700 rem split user record
2710 f1$="":f2$="":f3$="":f4$="":f5$=""
2720 fi=1
2730 for ix=1 to len(u$)
2740 q$=mid$(u$,ix,1)
2750 if q$=";" then fi=fi+1:goto 2810
2760 if fi=1 then f1$=f1$+q$
2770 if fi=2 then f2$=f2$+q$
2780 if fi=3 then f3$=f3$+q$
2790 if fi=4 then f4$=f4$+q$
2800 if fi=5 then f5$=f5$+q$
2810 next ix
2820 return

2900 rem update current user record
2910 if ur=0 then return
2920 if mf$="" then mf$=" "
2930 open 15,dd,15
2940 open 2,dd,2,"users"
2950 rn=ur:gosub 8000
2960 r$=mf$+" "+n$+";"+o$+";"+ci$+";"+pw$+";"+str$(hm)
2970 gosub 8200
2980 close 2
2990 close 15
2995 return

3000 rem sysop functions - reserved
3010 return

4000 rem temporary command loop
4010 gosub 5040
4020 a1$=n$+"? command (a,g,?): ":n=1:gosub 5040
4030 c=1:ml=1:gosub 5170
4040 if cd then goto 7900
4050 if b$="" then 4000
4060 if b$="a" then gosub 9000:goto 4000
4070 if b$="g" then 4200
4080 if b$="?" then 4100
4090 a$="i don't understand '"+b$+"'":gosub 5040
4095 goto 4000

4100 rem temporary help
4110 a$="a - change message area":gosub 5040
4120 a$="g - goodbye":gosub 5040
4130 a$="? - this help":gosub 5040
4140 goto 4000

4200 rem temporary goodbye
4210 gosub 5040
4220 a$="thanks for calling, "+n$+".":gosub 5040
4230 a$="please call again!":gosub 5040
4240 if ur>0 then gosub 2900
4250 lg=0
4260 a$="please disconnect.":gosub 5040
4270 goto 7800

5040 rem rbbs-128 output service
5050 if a1$="" then 5080
5060 a$=a1$
5070 a1$=""
5080 if len(a$)=0 then 5140
5090 for ix=1 to len(a$)
5100 ch=asc(mid$(a$,ix,1))
5110 gosub 5800
5120 gosub 5700
5130 next ix
5135 pp$=a$
5140 if n=1 then 5160
5150 ch=13:gosub 5800:ch=10:gosub 5800:print
5160 a$="":n=0:return

5170 rem rbbs-128 line input service
5180 b$=""
5190 gosub 6210
5200 return

5600 rem initialize swiftlink acia
5610 poke ta,30
5620 poke ca,11
5630 return

5700 rem display ascii byte on c128
5710 x=ch
5720 if x>=97 and x<=122 then x=x-32
5730 print chr$(x);
5740 return

5800 rem send ascii byte to tcpsrv
5810 if (peek(sa) and 16)=0 then 5810
5820 poke da,ch
5830 return

6000 rem get serial byte
6010 if (peek(sa) and 8)=0 then 6010
6020 ch=peek(da)
6030 return

6100 rem get raw tcpsrv control line
6110 ct$=""
6120 gosub 6000
6130 if ch=10 then 6120
6140 if ch=13 then 6180
6150 if ch<32 or ch>126 then 6120
6160 ct$=ct$+chr$(ch)
6170 goto 6120
6180 return

6210 rem rbbs-128 character line editor
6220 b$=""
6230 gosub 6000
6240 if ch=10 then 6230
6250 if ch=13 then 6520
6260 if ch=8 then 6400
6270 if ch=127 then 6400
6280 if ch=18 then 6450
6290 if ch=21 then 6480
6300 if ch=24 then 6480
6310 if ch=12 then 6450
6320 if ch<32 then 6230
6330 if ch>126 then 6230
6340 if len(b$)>=ml then 6230
6350 x=ch
6360 if x>=97 and x<=122 then x=x-32
6370 b$=b$+chr$(x)
6380 if c=1 then gosub 6680
6390 goto 6230

6400 rem delete last character
6410 if len(b$)=0 then 6230
6420 b$=left$(b$,len(b$)-1)
6430 if c=2 then 6230
6440 ch=8:gosub 6680
6445 goto 6230

6450 rem ctrl-r or ctrl-l - retype line
6455 if c=2 then 6230
6460 print
6465 if len(b$)=0 then 6230
6470 for ix=1 to len(b$)
6472 ch=asc(mid$(b$,ix,1))
6474 gosub 6680
6476 next ix
6478 goto 6230

6480 rem ctrl-u or ctrl-x - erase line
6485 if len(b$)=0 then 6230
6490 if c=2 then b$="":goto 6230
6495 for ix=1 to len(b$)
6500 ch=8:gosub 6680
6505 next ix
6510 b$=""
6515 goto 6230

6520 rem finish input line
6525 if right$(b$,len(c3$))=c3$ then cd=-1:return
6530 if c=1 then ch=13:gosub 6600
6535 if c=2 then print
6540 ch=13:gosub 5800
6545 ch=10:gosub 5800
6550 return

6600 rem echo ascii byte locally
6610 if ch=13 then print:return
6620 if ch=10 then return
6630 if ch=8 then print chr$(20);:return
6640 x=ch
6650 if x>=97 and x<=122 then x=x-32
6660 print chr$(x);
6670 return

6680 rem echo ascii byte local and remote
6685 gosub 5800
6690 gosub 6600
6695 return

6700 rem display ascii string locally
6710 for ix=1 to len(a$)
6720 x=asc(mid$(a$,ix,1))
6730 if x>=97 and x<=122 then x=x-32
6740 print chr$(x);
6750 next ix
6760 print
6770 return

7000 rem waiting for call
7010 cd=0:lg=0:ur=0
7020 print
7030 print "waiting for call..."
7040 gosub 6100
7050 p=instr(ct$,c1$)
7060 if p>0 then 7200
7070 goto 7040

7200 rem process connect and host date/time
7210 dt$=mid$(ct$,p+len(c1$))
7220 if len(dt$)<19 then 7300
7230 dd$=left$(dt$,2)
7240 mo$=mid$(dt$,4,2)
7250 yr$=mid$(dt$,7,4)
7260 tm$=mid$(dt$,12,8)
7270 ti$=mid$(dt$,12,2)+mid$(dt$,15,2)+mid$(dt$,18,2)
7280 print
7285 print "caller connected"
7290 print "date: ";dd$;"/";mo$;"/";yr$
7292 print "time: ";tm$
7295 goto 7400

7300 rem invalid time packet
7310 print "invalid time packet"
7320 goto 7800

7400 rem start rbbs caller session
7410 cd=0
7420 scnclr
7430 a$="rbbs-128 1.0":gosub 5040
7440 gosub 5040
7450 a$="commodore 128 remote bulletin board":gosub 5040
7460 gosub 5040
7470 goto 1000

7800 rem wait for caller disconnect
7810 gosub 6100
7820 if instr(ct$,c3$)>0 then 7900
7830 goto 7810

7900 rem caller disconnected cleanup
7910 if lg and ur>0 then gosub 2900
7920 cd=0:lg=0:ur=0
7930 n$="":o$="":pw$="":ci$="":mf$=""
7940 scnclr
7950 print "rbbs-128 1.0"
7960 print
7970 print "caller disconnected"
7980 goto 7000

8000 rem position 62 byte user record
8010 record#2,(rn),1
8020 return

8100 rem read 62 byte rel record
8110 r$=""
8120 for ri=1 to 62
8130 get#2,q$
8140 if q$="" then q$=chr$(0)
8150 r$=r$+q$
8160 next ri
8170 return

8200 rem write 62 byte rel record
8210 if len(r$)>=62 then 8240
8220 r$=r$+" "
8230 goto 8210
8240 if len(r$)>62 then r$=left$(r$,62)
8250 print#2,r$;
8260 return

8300 rem read system counters
8310 tc=0:mg=0:ls=0:rc=0
8320 dopen#4,"counters",d0,u9
8330 record#4,1,1
8340 r$=""
8350 for ri=1 to 32
8360 get#4,q$
8370 if q$="" then q$=" "
8380 r$=r$+q$
8390 next ri
8400 dclose#4
8410 z1$="":z2$="":z3$="":z4$=""
8420 zi=1
8430 for ix=1 to len(r$)
8440 q$=mid$(r$,ix,1)
8450 if q$=";" then zi=zi+1:goto 8500
8460 if zi=1 then z1$=z1$+q$
8470 if zi=2 then z2$=z2$+q$
8480 if zi=3 then z3$=z3$+q$
8490 if zi=4 then z4$=z4$+q$
8500 next ix
8510 tc=val(z1$):mg=val(z2$):ls=val(z3$):rc=val(z4$)
8520 return

8600 rem save system counters
8610 r$=str$(tc)+";"+str$(mg)+";"+str$(ls)+";"+str$(rc)
8620 if len(r$)>=32 then 8650
8630 r$=r$+" "
8640 goto 8620
8650 if len(r$)>32 then r$=left$(r$,32)
8660 dopen#4,"counters",d0,u9
8670 record#4,1,1
8680 print#4,r$;
8690 dclose#4
8695 return

8700 rem record successful caller
8710 tc=tc+1
8720 rc=rc+1
8730 r$=dd$+"/"+mo$+"/"+yr$+" "+tm$+";"+n$+";"+o$+";"+ci$
8740 if len(r$)>=96 then 8770
8750 r$=r$+" "
8760 goto 8740
8770 if len(r$)>96 then r$=left$(r$,96)
8780 dopen#5,"callers",d0,u9
8790 record#5,rc+1,1
8800 print#5,r$;
8810 record#5,1,1
8820 r$=str$(rc)
8830 if len(r$)>=96 then 8860
8840 r$=r$+" "
8850 goto 8830
8860 if len(r$)>96 then r$=left$(r$,96)
8870 print#5,r$;
8880 dclose#5
8890 gosub 8600
8895 return

9000 rem message area selector
9010 gosub 5040
9020 a$="message areas":gosub 5040
9030 gosub 5040
9040 if na<1 then 9290
9050 for ai=1 to na
9060 a$=str$(ai)+" - "+ya$(ai):gosub 5040
9070 next ai
9080 gosub 5040
9090 a1$="select area (1-"+mid$(str$(na),2)+"): ":n=1:gosub 5040
9092 c=1:ml=3:gosub 5170
9094 if cd then return
9096 if b$="" then 9090
9098 ma=val(b$)
9100 if ma<1 or ma>na then 9090
9110 an$=ya$(ma)
9120 sn$=ys$(ma)
9130 mn$=ym$(ma)
9140 at$=yt$(ma)
9150 gosub 9900
9160 gosub 5040
9170 a$="current area: "+an$:gosub 5040
9180 a$="messages:"+str$(mc):gosub 5040
9190 return
9290 a$="no message areas configured.":gosub 5040
9295 return

9600 rem read 64 byte area record
9610 r$=""
9620 for ri=1 to 64
9630 get#6,q$
9640 if q$="" then q$=" "
9650 r$=r$+q$
9660 next ri
9670 return

9700 rem split message area definition
9710 an$="":sn$="":mn$="":at$=""
9720 fi=1
9730 for ix=1 to len(r$)
9740 q$=mid$(r$,ix,1)
9750 if q$=";" then fi=fi+1:goto 9800
9760 if fi=1 then an$=an$+q$
9770 if fi=2 then sn$=sn$+q$
9780 if fi=3 then mn$=mn$+q$
9790 if fi=4 then at$=at$+q$
9800 next ix
9810 gosub 9820
9815 return

9820 rem trim area fields
9830 if len(an$)>0 and right$(an$,1)=" " then an$=left$(an$,len(an$)-1):goto 9830
9840 if len(sn$)>0 and right$(sn$,1)=" " then sn$=left$(sn$,len(sn$)-1):goto 9840
9850 if len(mn$)>0 and right$(mn$,1)=" " then mn$=left$(mn$,len(mn$)-1):goto 9850
9860 if len(at$)>0 and right$(at$,1)=" " then at$=left$(at$,len(at$)-1):goto 9860
9870 return

9900 rem load active area summary index
9910 mz=0:mx=0:iu=0:lm=0:ac=0
9920 dopen#7,(sn$),d0,u9
9930 re=1
9940 record#7,re,1
9950 gosub 10100
9960 g=val(r$)
9970 if g>9998 then 10060
9980 if g>lm then lm=g
9990 mz=mz+1
10000 if g<>0 then ac=ac+1
10010 if mz<=200 then m(mz,1)=g
10020 if g<>0 and iu=0 then iu=g
10030 re=re+5
10040 record#7,re,1
10050 gosub 10100
10052 if mz<=200 then m(mz,2)=val(r$)
10054 mx=mx+val(r$)+6
10056 re=re+1
10058 goto 9940
10060 dclose#7
10070 mc=ac
10080 return

10100 rem read 30 byte summary record
10110 r$=""
10120 for ri=1 to 30
10130 get#7,q$
10140 if q$="" then q$=" "
10150 r$=r$+q$
10160 next ri
10170 return

10200 rem load message areas at startup
10210 na=0
10220 dopen#6,"msgareas",d0,u9
10230 record#6,1,1
10240 gosub 9600
10250 na=val(r$)
10260 if na>16 then na=16
10270 if na<1 then 10380
10280 for ai=1 to na
10290 record#6,ai+1,1
10300 gosub 9600
10310 gosub 9700
10320 ya$(ai)=an$
10330 ys$(ai)=sn$
10340 ym$(ai)=mn$
10350 yt$(ai)=at$
10360 next ai
10380 dclose#6
10390 return

10400 rem per user area last-read pointers - next stage
10410 return

11000 rem common message engine - future
11010 return

14000 rem caller log and statistics - future
14010 return

15000 rem bulletins news and help - future
15010 return

16000 rem file area system - future
16010 return

17000 rem punter file transfers - future
17010 return

18000 rem doors and external programs - future
18010 return

19000 rem sysop chat and status window - future
19010 return

20000 rem ansi terminal support - future
20010 return

21000 rem reserved expansion
21010 return

Blacklord

RBBS-128 1.0 is the first functional proof release containing:

  • TCPSRV-based incoming call handling and disconnect detection
  • C128 SwiftLink/ACIA serial I/O
  • user registration and password login
  • persistent REL user records
  • caller counters/history
  • SYSOP flag/privileges
  • multiple message areas
  • dedicated Private Mail area
  • public/private message entry
  • message retrieval
  • summary scanning
  • new-message reading
  • per-user/per-area last-read tracking
  • replies
  • message deletion with ownership/SYSOP rules
  • Australian date handling

The current command loop already represents the core messaging release nicely:

a - change message area
e - enter a message
p - reply to a message
r - retrieve a message
s - scan message summaries
n - read new messages
k - kill a message
g - goodbye
? - help

Blacklord

This is version 1.01 - changes :

Generic ML REL reader for all fixed-length records.
Generic ML REL writer, including automatic padding/truncation.
ML SwiftLink output for the remote caller (major increase in output speed).
ML local C128 output, replacing the extremely expensive BASIC per-character loop.
Non-printable record bytes filtered from local output, eliminating some weird (and random) blank lines.
The local-display benchmark improved from 4553 to 68 jiffies, roughly 67× faster.
At 100% C128 speed, the real BBS now shows zero perceptible local/remote output lag.
Dead experimental/read/write code has been cleaned out.
Current BASIC memory checkpoint: fre(0) = 34764 - plenty of room for new features!

At this point it is still only a message based system, but I will start adding other functionality.

   10 rem rbbs-128 1.01 main program
   20 da=56832:sa=56833:ca=56834:ta=56835
   30 sd=8:dd=9:fd=10
   40 fast
   45 dim m(200,2),ms$(10),ya$(16),ys$(16),ym$(16),yt$(16),lr(16)
   50 graphic 5
   60 poke ta,30:poke ca,11
   62 c1$=chr$(35)+chr$(67)+chr$(79)+chr$(78)+chr$(78)+chr$(69)+chr$(67)+chr$(84)+chr$(58)
   64 c3$=chr$(35)+chr$(68)+chr$(73)+chr$(83)+chr$(67)+chr$(79)+chr$(78)+chr$(78)+chr$(69)+chr$(67)+chr$(84)
   65 af=0
   70 scnclr
   80 print "rbbs-128 1.01"
   90 print
  100 print "commodore 128 remote bulletin board"
  110 print
  120 gosub 22000:gosub 22800:gosub 22450:gosub 22520:gosub 5400:gosub 6800:gosub 8300:gosub 10200:goto 7000
 1000 rem caller login
 1010 ur=0:hm=0:mf$="":pw$="":ci$=""
 1020 a1$="enter your first name: ":n=1:gosub 5040
 1030 c=1:ml=20:gosub 5170
 1040 if cd then goto 7900
 1050 n$=b$
 1060 if n$="" then 1020
 1070 if n$<"a" or len(n$)=1 then 1020
 1080 ck=0
 1090 for ix=1 to len(n$)
 1100 if mid$(n$,ix,1)=" " then ck=1
 1110 next ix
 1120 if ck=0 then 1150
 1130 a$="please do not use spaces in your name":gosub 5040
 1140 gosub 5040:goto 1020
 1150 a1$="enter your last name:  ":n=1:gosub 5040
 1160 c=1:ml=20:gosub 5170
 1170 if cd then goto 7900
 1180 o$=b$
 1190 if o$="" then 1020
 1200 if o$<"a" or len(o$)=1 then 1020
 1210 ck=0
 1220 for ix=1 to len(o$)
 1230 if mid$(o$,ix,1)=" " then ck=1
 1240 next ix
 1250 if ck=0 then 1280
 1260 a$="please do not use spaces in your name":gosub 5040
 1270 gosub 5040:goto 1150
 1280 a$="checking user file...":gosub 5040
 1290 gosub 2000
 1300 if ok=0 then 1400
 1310 a1$="enter your password: ":n=1:gosub 5040
 1320 c=2:ml=20:gosub 5170
 1330 if cd then goto 7900
 1340 if b$=pw$ then 1370
 1350 a$="incorrect password":gosub 5040
 1360 goto 1310
 1370 a$="login accepted":gosub 5040
 1380 a$="welcome "+n$+" "+o$:gosub 5040
 1390 goto 1800
 1400 rem confirm unrecognised caller name
 1410 gosub 5040
 1420 a$="name entered: "+n$+" "+o$:gosub 5040
 1430 a1$="is this correct (y/n)? ":n=1:gosub 5040
 1440 c=1:ml=1:gosub 5170
 1450 if cd then goto 7900
 1460 if b$="" then 1430
 1470 if asc(b$)=78 then 1020
 1480 if asc(b$)=89 then 1500
 1490 goto 1430
 1500 rem new caller
 1510 a$="new user registration":gosub 5040
 1520 gosub 2200
 1530 if cd then goto 7900
 1540 if ok=0 then 1020
 1550 a$="registration complete":gosub 5040
 1560 a$="welcome "+n$+" "+o$:gosub 5040
 1570 goto 1800
 1800 rem login complete
 1810 lg=-1
 1820 gosub 8700
 1825 gosub 10400
 1830 gosub 5040
 1832 if mf$<>"#" then 1840
 1834 a$="you have sysop privileges":gosub 5040
 1836 gosub 5040
 1840 a$="you are caller number:"+str$(tc):gosub 5040
 1850 a$="rbbs-128 login complete.":gosub 5040
 1860 a$="date/time: "+dd$+"/"+mo$+"/"+yr$+" "+tm$:gosub 5040
 1870 gosub 9000
 1880 goto 4000
 2000 rem check rel users file
 2010 ok=0:pw$="":ci$="":hm=0:ur=0:mf$=""
 2040 rn=1:gosub 8000:gosub 8100
 2050 nu=val(r$)
 2060 if nu<1 then 2160
 2070 for ur=2 to nu+1
 2080 rn=ur:gosub 8000:gosub 8100
 2090 u$=mid$(r$,3)
 2100 gosub 2700
 2110 if f1$=n$ and f2$=o$ then 2140
 2120 next ur
 2130 goto 2160
 2140 mf$=left$(r$,1)
 2150 pw$=f4$:ci$=f3$:hm=val(f5$):ok=-1
 2160 return
 2180 return
 2200 rem new user registration
 2210 ok=0
 2220 a1$="city/state: ":n=1:gosub 5040
 2230 c=1:ml=30:gosub 5170
 2240 if cd then return
 2250 ci$=b$
 2260 if len(ci$)<2 then 2220
 2270 a1$="choose a password: ":n=1:gosub 5040
 2280 c=2:ml=20:gosub 5170
 2290 if cd then return
 2300 p1$=b$
 2310 if len(p1$)<3 then 2270
 2320 a1$="enter password again: ":n=1:gosub 5040
 2330 c=2:ml=20:gosub 5170
 2340 if cd then return
 2350 if b$=p1$ then 2390
 2360 a$="passwords do not match":gosub 5040
 2370 gosub 5040
 2380 goto 2270
 2390 gosub 5040
 2400 a$="name: "+n$+" "+o$:gosub 5040
 2410 a$="city/state: "+ci$:gosub 5040
 2420 a1$="is this correct (y/n)? ":n=1:gosub 5040
 2430 c=1:ml=1:gosub 5170
 2440 if cd then return
 2450 if b$="" then 2420
 2460 if asc(b$)=89 then 2500
 2470 if asc(b$)=78 then 2220
 2480 goto 2420
 2500 rem append new rel user
 2510 ok=0
 2540 rn=1:gosub 8000:gosub 8100
 2550 nu=val(r$)
 2560 rn=nu+2:ur=rn
 2570 gosub 8000
 2580 r$="  "+n$+";"+o$+";"+ci$+";"+p1$+";0"
 2590 gosub 8200
 2600 rn=1:gosub 8000
 2610 r$=str$(nu+1)
 2620 gosub 8200
 2640 input#15,en,em$,et,es
 2660 if en<>0 then 2690
 2670 pw$=p1$:hm=0:mf$=" ":ok=-1
 2672 gosub 10900
 2680 return
 2690 a$="error writing users file":gosub 5040
 2695 return
 2700 rem split user record
 2710 f1$="":f2$="":f3$="":f4$="":f5$=""
 2720 fi=1
 2730 for ix=1 to len(u$)
 2740 q$=mid$(u$,ix,1)
 2750 if q$=";" then fi=fi+1:goto 2810
 2760 if fi=1 then f1$=f1$+q$
 2770 if fi=2 then f2$=f2$+q$
 2780 if fi=3 then f3$=f3$+q$
 2790 if fi=4 then f4$=f4$+q$
 2800 if fi=5 then f5$=f5$+q$
 2810 next ix
 2820 return
 2900 rem update current user record
 2905 if ma>0 and ma<=16 then lr(ma)=hm
 2907 gosub 10710
 2910 if ur=0 then return
 2920 if mf$="" then mf$=" "
 2950 rn=ur:gosub 8000
 2960 r$=mf$+" "+n$+";"+o$+";"+ci$+";"+pw$+";"+str$(hm)
 2970 gosub 8200
 2995 return
 3000 rem sysop functions - reserved
 3010 return
 4000 rem temporary command loop
 4010 gosub 5040
 4020 a1$=n$+"? command (a,e,p,r,s,n,k,g,?): ":n=1:gosub 5040
 4030 c=1:ml=1:gosub 5170
 4040 if cd then goto 7900
 4050 if b$="" then 4000
 4060 if b$="a" then gosub 9000:goto 4000
 4062 if b$="e" then gosub 11000:goto 4000
 4064 if b$="p" then gosub 14800:goto 4000
 4066 if b$="r" then gosub 12300:goto 4000
 4068 if b$="s" then gosub 13300:goto 4000
 4070 if b$="n" then gosub 14000:goto 4000
 4072 if b$="k" then gosub 15300:goto 4000
 4074 if b$="g" then 4200
 4080 if b$="?" then 4100
 4090 a$="i don't understand '"+b$+"'":gosub 5040
 4095 goto 4000
 4100 rem temporary help
 4110 a$="a - change message area":gosub 5040
 4112 a$="e - enter a message":gosub 5040
 4113 a$="p - reply to a message":gosub 5040
 4114 a$="r - retrieve a message":gosub 5040
 4116 a$="s - scan message summaries":gosub 5040
 4118 a$="n - read new messages":gosub 5040
 4119 a$="k - kill a message":gosub 5040
 4120 a$="g - goodbye":gosub 5040
 4130 a$="? - this help":gosub 5040
 4140 goto 4000
 4200 rem temporary goodbye
 4210 gosub 5040
 4220 a$="thanks for calling, "+n$+".":gosub 5040
 4230 a$="please call again!":gosub 5040
 4240 if ur>0 then gosub 2900
 4250 lg=0
 4260 a$="please disconnect.":gosub 5040
 4270 goto 7800
 5040 rem rbbs-128 output service
 5050 if a1$="" then 5080
 5060 a$=a1$
 5070 a1$=""
 5080 if len(a$)=0 then 5140
 5090 gosub 5220
 5100 gosub 5460
 5135 pp$=a$
 5140 if n=1 then 5160
 5150 ch=13:gosub 5800:ch=10:gosub 5800:print
 5160 a$="":n=0:return
 5170 rem rbbs-128 line input service
 5180 b$=""
 5190 gosub 6210
 5200 return
 5220 rem ml transmit a$
 5230 p=pointer(a$)
 5240 bank 1
 5250 ln=peek(p)
 5260 q=peek(p+1)+256*peek(p+2)
 5270 bank 15
 5280 qh=int(q/256)
 5290 ql=q-qh*256
 5300 sys 4864,ql,qh,ln
 5310 return
 5320 rem generic ml rel write
 5330 p=pointer(r$)
 5340 bank 1
 5350 wl=peek(p)
 5360 q=peek(p+1)+256*peek(p+2)
 5370 bank 15
 5380 qh=int(q/256):ql=q-qh*256
 5390 poke 253,wf:poke 254,wlm
 5395 sys 5216,ql,qh,wl
 5398 return
 5400 rem initialise generic ml rel buffer
 5410 ib$=""
 5420 for ri=1 to 96
 5430 ib$=ib$+" "
 5440 next ri
 5450 return
 5460 rem ml local display a$
 5470 p=pointer(a$)
 5480 bank 1
 5490 ln=peek(p)
 5492 q=peek(p+1)+256*peek(p+2)
 5494 bank 15
 5496 qh=int(q/256):ql=q-qh*256
 5498 sys 5280,ql,qh,ln
 5499 return
 5500 rem generic ml rel read
 5510 p=pointer(ib$)
 5520 bank 1
 5530 q=peek(p+1)+256*peek(p+2)
 5540 bank 15
 5550 qh=int(q/256):ql=q-qh*256
 5560 poke 253,rf:poke 254,rl
 5570 sys 5152,ql,qh
 5580 r$=left$(ib$,rl)
 5590 return
 5600 rem initialize swiftlink acia
 5610 poke ta,30
 5620 poke ca,11
 5630 return
 5700 rem display ascii byte on c128
 5710 x=ch
 5715 if x<32 or x>126 then return
 5720 if x>=97 and x<=122 then x=x-32
 5730 print chr$(x);
 5740 return
 5800 rem send ascii byte to tcpsrv
 5810 if (peek(sa) and 16)=0 then 5810
 5820 poke da,ch
 5830 return
 6000 rem get serial byte
 6010 if (peek(sa) and 8)=0 then 6010
 6020 ch=peek(da)
 6030 return
 6100 rem get raw tcpsrv control line
 6110 ct$=""
 6120 gosub 6000
 6130 if ch=10 then 6120
 6140 if ch=13 then 6180
 6150 if ch<32 or ch>126 then 6120
 6160 ct$=ct$+chr$(ch)
 6170 goto 6120
 6180 return
 6210 rem rbbs-128 character line editor
 6220 b$=""
 6230 gosub 6000
 6240 if ch=10 then 6230
 6250 if ch=13 then 6520
 6260 if ch=8 then 6400
 6270 if ch=127 then 6400
 6280 if ch=18 then 6450
 6290 if ch=21 then 6480
 6300 if ch=24 then 6480
 6310 if ch=12 then 6450
 6320 if ch<32 then 6230
 6330 if ch>126 then 6230
 6340 if len(b$)>=ml then 6230
 6350 x=ch
 6360 if x>=97 and x<=122 then x=x-32
 6370 b$=b$+chr$(x)
 6380 if c=1 then gosub 6680
 6390 goto 6230
 6400 rem delete last character
 6410 if len(b$)=0 then 6230
 6420 b$=left$(b$,len(b$)-1)
 6430 if c=2 then 6230
 6440 ch=8:gosub 6680
 6445 goto 6230
 6450 rem ctrl-r or ctrl-l - retype line
 6455 if c=2 then 6230
 6460 print
 6465 if len(b$)=0 then 6230
 6470 for ix=1 to len(b$)
 6472 ch=asc(mid$(b$,ix,1))
 6474 gosub 6680
 6476 next ix
 6478 goto 6230
 6480 rem ctrl-u or ctrl-x - erase line
 6485 if len(b$)=0 then 6230
 6490 if c=2 then b$="":goto 6230
 6495 for ix=1 to len(b$)
 6500 ch=8:gosub 6680
 6505 next ix
 6510 b$=""
 6515 goto 6230
 6520 rem finish input line
 6525 if right$(b$,len(c3$))=c3$ then cd=-1:return
 6530 if c=1 then ch=13:gosub 6600
 6535 if c=2 then print
 6540 ch=13:gosub 5800
 6545 ch=10:gosub 5800
 6550 return
 6600 rem echo ascii byte locally
 6610 if ch=13 then print:return
 6620 if ch=10 then return
 6630 if ch=8 then print chr$(20);:return
 6640 x=ch
 6650 if x>=97 and x<=122 then x=x-32
 6660 print chr$(x);
 6670 return
 6680 rem echo ascii byte local and remote
 6685 gosub 5800
 6690 gosub 6600
 6695 return
 6700 rem display ascii string locally
 6710 for ix=1 to len(a$)
 6720 x=asc(mid$(a$,ix,1))
 6730 if x>=97 and x<=122 then x=x-32
 6740 print chr$(x);
 6750 next ix
 6760 print
 6770 return
 6800 rem open persistent rbbs data files
 6810 open 15,dd,15
 6820 open 2,dd,2,"users"
 6830 dopen#4,"counters",d0,u9
 6840 dopen#5,"callers",d0,u9
 6850 dopen#8,"lastread",d0,u9
 6860 af=0
 6870 return
 6880 return
 7000 rem waiting for call
 7010 cd=0:lg=0:ur=0
 7020 print
 7030 print "waiting for call..."
 7040 gosub 6100
 7050 p=instr(ct$,c1$)
 7060 if p>0 then 7200
 7070 goto 7040
 7200 rem process connect and host date/time
 7210 dt$=mid$(ct$,p+len(c1$))
 7220 if len(dt$)<19 then 7300
 7230 dd$=left$(dt$,2)
 7240 mo$=mid$(dt$,4,2)
 7250 yr$=mid$(dt$,7,4)
 7260 tm$=mid$(dt$,12,8)
 7270 ti$=mid$(dt$,12,2)+mid$(dt$,15,2)+mid$(dt$,18,2)
 7280 print
 7285 print "caller connected"
 7290 print "date: ";dd$;"/";mo$;"/";yr$
 7292 print "time: ";tm$
 7295 goto 7400
 7300 rem invalid time packet
 7310 print "invalid time packet"
 7320 goto 7800
 7400 rem start rbbs caller session
 7410 cd=0
 7420 scnclr
 7430 a$="rbbs-128 1.01":gosub 5040
 7440 gosub 5040
 7450 a$="commodore 128 remote bulletin board":gosub 5040
 7460 gosub 5040
 7470 goto 1000
 7800 rem wait for caller disconnect
 7810 gosub 6100
 7820 if instr(ct$,c3$)>0 then 7900
 7830 goto 7810
 7900 rem caller disconnected cleanup
 7910 if lg and ur>0 then gosub 2900
 7920 cd=0:lg=0:ur=0
 7930 n$="":o$="":pw$="":ci$="":mf$=""
 7940 scnclr
 7950 print "rbbs-128 1.01"
 7960 print
 7970 print "caller disconnected"
 7980 goto 7000
 8000 rem position 62 byte user record
 8010 record#2,(rn),1
 8020 return
 8100 rem read 62 byte user record via ml
 8110 rf=2:rl=62
 8120 gosub 5500
 8130 return
 8200 rem write 62 byte user record via ml
 8210 wf=2:wlm=62
 8220 gosub 5320
 8230 return
 8300 rem read system counters
 8310 tc=0:mg=0:ls=0:rc=0
 8330 record#4,1,1
 8340 rf=4:rl=32
 8350 gosub 5500
 8410 z1$="":z2$="":z3$="":z4$=""
 8420 zi=1
 8430 for ix=1 to len(r$)
 8440 q$=mid$(r$,ix,1)
 8450 if q$=";" then zi=zi+1:goto 8500
 8460 if zi=1 then z1$=z1$+q$
 8470 if zi=2 then z2$=z2$+q$
 8480 if zi=3 then z3$=z3$+q$
 8490 if zi=4 then z4$=z4$+q$
 8500 next ix
 8510 tc=val(z1$):mg=val(z2$):ls=val(z3$):rc=val(z4$)
 8520 return
 8600 rem save system counters
 8610 r$=str$(tc)+";"+str$(mg)+";"+str$(ls)+";"+str$(rc)
 8620 record#4,1,1
 8630 wf=4:wlm=32
 8640 gosub 5320
 8650 return
 8700 rem record successful caller
 8710 tc=tc+1
 8720 rc=rc+1
 8730 r$=dd$+"/"+mo$+"/"+yr$+" "+tm$+";"+n$+";"+o$+";"+ci$
 8740 record#5,rc+1,1
 8750 wf=5:wlm=96
 8760 gosub 5320
 8770 record#5,1,1
 8780 r$=str$(rc)
 8790 gosub 5320
 8800 gosub 8600
 8810 return
 9000 rem message area selector
 9010 gosub 5040
 9020 a$="message areas":gosub 5040
 9030 gosub 5040
 9040 if na<1 then 9290
 9050 for ai=1 to na
 9060 a$=str$(ai)+" - "+ya$(ai):gosub 5040
 9070 next ai
 9080 gosub 5040
 9090 a1$="select area (1-"+mid$(str$(na),2)+"): ":n=1:gosub 5040
 9092 c=1:ml=3:gosub 5170
 9094 if cd then return
 9096 if b$="" then 9090
 9098 ma=val(b$)
 9100 if ma<1 or ma>na then 9090
 9105 if af=0 then 9110
 9106 dclose#3
 9107 dclose#7
 9108 af=0
 9110 an$=ya$(ma)
 9120 sn$=ys$(ma)
 9130 mn$=ym$(ma)
 9140 at$=yt$(ma)
 9142 hm=lr(ma)
 9144 dopen#7,(sn$),d0,u9
 9146 dopen#3,(mn$),d0,u9
 9148 af=-1
 9150 gosub 9900
 9160 gosub 5040
 9170 a$="current area: "+an$:gosub 5040
 9180 a$="messages:"+str$(mc):gosub 5040
 9190 return
 9290 a$="no message areas configured.":gosub 5040
 9295 return
 9600 rem read 64 byte area record via ml
 9610 rf=6:rl=64
 9620 gosub 5500
 9630 return
 9700 rem split message area definition
 9710 an$="":sn$="":mn$="":at$=""
 9720 fi=1
 9730 for ix=1 to len(r$)
 9740 q$=mid$(r$,ix,1)
 9750 if q$=";" then fi=fi+1:goto 9800
 9760 if fi=1 then an$=an$+q$
 9770 if fi=2 then sn$=sn$+q$
 9780 if fi=3 then mn$=mn$+q$
 9790 if fi=4 then at$=at$+q$
 9800 next ix
 9810 gosub 9820
 9815 return
 9820 rem trim area fields
 9830 if len(an$)>0 and right$(an$,1)=" " then an$=left$(an$,len(an$)-1):goto 9830
 9840 if len(sn$)>0 and right$(sn$,1)=" " then sn$=left$(sn$,len(sn$)-1):goto 9840
 9850 if len(mn$)>0 and right$(mn$,1)=" " then mn$=left$(mn$,len(mn$)-1):goto 9850
 9860 if len(at$)>0 and right$(at$,1)=" " then at$=left$(at$,len(at$)-1):goto 9860
 9870 return
 9900 rem load active area summary index
 9910 mz=0:mx=0:iu=0:lm=0:ac=0
 9930 re=1
 9940 record#7,re,1
 9950 gosub 10100
 9960 g=val(r$)
 9970 if g>9998 then 10070
 9980 if g>lm then lm=g
 9990 mz=mz+1
10000 if g<>0 then ac=ac+1
10010 if mz<=200 then m(mz,1)=g
10020 if g<>0 and iu=0 then iu=g
10030 re=re+5
10040 record#7,re,1
10050 gosub 10100
10052 if mz<=200 then m(mz,2)=val(r$)
10054 mx=mx+val(r$)+6
10056 re=re+1
10058 goto 9940
10070 mc=ac
10080 return
10100 rem read 30 byte summary record via ml
10110 rf=7:rl=30
10120 gosub 5500
10130 return
10200 rem load message areas at startup
10210 na=0
10220 dopen#6,"msgareas",d0,u9
10230 record#6,1,1
10240 gosub 9600
10250 na=val(r$)
10260 if na>16 then na=16
10270 if na<1 then 10380
10280 for ai=1 to na
10290 record#6,ai+1,1
10300 gosub 9600
10310 gosub 9700
10320 ya$(ai)=an$
10330 ys$(ai)=sn$
10340 ym$(ai)=mn$
10350 yt$(ai)=at$
10360 next ai
10380 dclose#6
10390 return
10400 rem load user area last-read pointers
10410 for li=1 to 16
10420 lr(li)=0
10430 next li
10440 if ur<2 then return
10460 record#8,ur,1
10470 rf=8:rl=96
10480 gosub 5500
10540 gosub 10600
10550 return
10600 rem split last-read record
10610 li=1:v$=""
10620 for ix=1 to len(r$)
10630 q$=mid$(r$,ix,1)
10640 if q$=";" then lr(li)=val(v$):li=li+1:v$="":goto 10680
10650 if q$=" " then 10680
10660 if li>16 then 10690
10670 v$=v$+q$
10680 next ix
10690 if li<=16 and v$<>"" then lr(li)=val(v$)
10700 return
10710 rem save user area last-read pointers
10720 if ur<2 then return
10730 r$=""
10740 for li=1 to 16
10750 r$=r$+mid$(str$(lr(li)),2)
10760 if li<16 then r$=r$+";"
10770 next li
10780 record#8,ur,1
10790 wf=8:wlm=96
10800 gosub 5320
10810 return
10900 rem create new user last-read record
10910 if ur<2 then return
10920 r$="0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
10930 record#8,ur,1
10940 wf=8:wlm=96
10950 gosub 5320
10960 return
11000 rem enter new message
11010 gosub 5040
11020 if at$="m" then 11100
11030 pv=0
11040 a1$="to (return for all): ":n=1:gosub 5040
11050 c=1:ml=30:gosub 5170
11060 if cd then return
11070 if b$="" then t$="all":goto 11140
11080 t$=b$
11090 goto 11140
11100 rem private mail recipient
11110 pv=-1
11120 a1$="to: ":n=1:gosub 5040
11130 c=1:ml=30:gosub 5170
11132 if cd then return
11134 if b$="" then 11120
11136 t$=b$
11140 a1$="subject: ":n=1:gosub 5040
11150 c=1:ml=26:gosub 5170
11160 if cd then return
11170 if b$="" then 11140
11180 k$=b$
11200 rem use tcpsrv supplied date and time
11210 d$=dd$+"/"+mo$+"/"+yr$+" "+left$(tm$,5)
11220 gosub 5040
11230 a$="enter up to 10 lines of text.":gosub 5040
11240 a$="enter a blank line when finished.":gosub 5040
11250 gosub 5040
11260 f=0
11270 if f=10 then 11350
11280 a1$=str$(f+1)+"> ":n=1:gosub 5040
11290 c=1:ml=63:gosub 5170
11300 if cd then return
11310 if b$="" then 11350
11320 f=f+1
11330 ms$(f)=b$
11340 goto 11270
11350 if f=0 then 11390
11360 a$="saving message.....":gosub 5040
11370 gosub 11500
11380 return
11390 a$="message aborted.":gosub 5040
11400 return
11500 rem save new message
11510 nv=lm+1
11520 if nv<1 then nv=1
11530 sr=mz*6+1
11540 rem write summary
11560 rn=sr:r$=str$(nv)
11570 if pv then r$=r$+";*"
11580 gosub 12000
11590 rn=sr+1:r$=d$:gosub 12000
11600 rn=sr+2:r$=n$+" "+o$:gosub 12000
11610 rn=sr+3:r$=t$:gosub 12000
11620 rn=sr+4:r$=k$:gosub 12000
11630 rn=sr+5:r$=str$(f):gosub 12000
11640 rn=sr+6:r$="9999":gosub 12000
11660 rem write full message
11670 mr=mx+1
11690 rn=mr:r$=str$(nv)
11700 if pv then r$=r$+";*"
11710 gosub 12100
11720 rn=mr+1:r$=d$:gosub 12100
11730 rn=mr+2:r$=n$+" "+o$:gosub 12100
11740 rn=mr+3:r$=t$:gosub 12100
11750 rn=mr+4:r$=k$:gosub 12100
11760 rn=mr+5:r$=str$(f):gosub 12100
11770 for mi=1 to f
11780 rn=mr+5+mi:r$=ms$(mi):gosub 12100
11790 next mi
11810 rem update active in-memory index
11820 mz=mz+1
11830 if mz<=200 then m(mz,1)=nv
11840 if mz<=200 then m(mz,2)=f
11850 mc=mc+1
11860 if iu=0 then iu=nv
11870 lm=nv
11880 mx=mx+f+6
11890 rem update system message total
11900 mg=mg+1
11910 ls=ls+1
11920 gosub 8600
11930 a$="message"+str$(nv)+" saved.":gosub 5040
11940 return
12000 rem write 30 byte summary record via ml
12010 record#7,rn,1
12020 wf=7:wlm=30
12030 gosub 5320
12040 return
12100 rem write 65 byte message record via ml
12110 record#3,rn,1
12120 wf=3:wlm=65
12130 gosub 5320
12140 return
12200 rem read 65 byte message record via generic ml
12210 rf=3:rl=65
12220 gosub 5500
12230 return
12300 rem retrieve message
12310 gosub 5040
12320 if mc=0 or iu=0 then 12900
12330 a1$="message number ("+mid$(str$(iu),2)+"-"+mid$(str$(lm),2)+"): "
12340 n=1:gosub 5040
12350 c=1:ml=5:gosub 5170
12360 if cd then return
12370 if b$="" then return
12380 mm=val(b$)
12390 if mm<iu or mm>lm then 12920
12395 a$="searching.....":gosub 5040
12400 rem find message in memory index
12410 mi=1:re=1
12420 if mi>mz then 12920
12430 if m(mi,1)=mm then 12480
12440 re=re+m(mi,2)+6
12450 mi=mi+1
12460 goto 12420
12480 rem retrieve selected message
12500 record#3,re,1
12510 gosub 12200
12520 z$=r$
12530 gosub 13000
12540 if ok=0 then 12940
12550 rem read message headers
12560 record#3,re+1,1:gosub 12200:d$=r$:gosub 13200:d$=r$
12570 record#3,re+2,1:gosub 12200:fr$=r$:gosub 13200:fr$=r$
12580 record#3,re+3,1:gosub 12200:pt$=r$:gosub 13200:pt$=r$
12590 record#3,re+4,1:gosub 12200:su$=r$:gosub 13200:su$=r$
12600 record#3,re+5,1:gosub 12200:lc=val(r$)
12610 rem display message
12620 gosub 5040
12630 a$="message:"+str$(mm):gosub 5040
12640 a$="date/time: "+d$:gosub 5040
12650 a$="from: "+fr$:gosub 5040
12660 a$="to: "+pt$:gosub 5040
12670 a$="subject: "+su$:gosub 5040
12680 gosub 5040
12690 for li=1 to lc
12700 record#3,re+5+li,1
12710 gosub 12200
12720 gosub 13200
12730 a$=r$:gosub 5040
12740 next li
12760 rem update active last-read pointer
12770 if mm<=hm then 12810
12780 hm=mm
12790 lr(ma)=hm
12800 gosub 10710
12810 return
12900 a$="no messages.":gosub 5040
12910 return
12920 a$="message not found.":gosub 5040
12930 return
12940 a$="private message - access denied.":gosub 5040
12950 return
13000 rem check message access
13010 ok=-1
13020 if at$<>"m" then return
13030 ok=0
13040 rem sysop always allowed
13050 if mf$="#" then ok=-1:return
13060 rem get sender
13070 record#3,re+2,1
13080 gosub 12200
13090 fr$=r$:gosub 13200:fr$=r$
13100 rem get recipient
13110 record#3,re+3,1
13120 gosub 12200
13130 pt$=r$:gosub 13200:pt$=r$
13140 un$=n$+" "+o$
13150 if fr$=un$ then ok=-1:return
13160 if pt$=un$ then ok=-1:return
13170 return
13200 rem trim trailing spaces
13210 if len(r$)=0 then return
13220 if right$(r$,1)<>" " then return
13230 r$=left$(r$,len(r$)-1)
13240 goto 13210
13300 rem scan message summaries
13310 gosub 5040
13320 if mc=0 or iu=0 then 13900
13330 a1$="start message ("+mid$(str$(iu),2)+"-"+mid$(str$(lm),2)+", return="+mid$(str$(iu),2)+"): "
13340 n=1:gosub 5040
13350 c=1:ml=5:gosub 5170
13360 if cd then return
13370 sm=iu
13380 if b$="" then 13410
13390 sm=val(b$)
13400 if sm<iu or sm>lm then 13330
13410 a$="searching.....":gosub 5040
13420 gosub 5040
13425 a$="msg lines date/time   from        to          subject":gosub 5040
13427 gosub 5040
13440 for mi=1 to mz
13450 mm=m(mi,1)
13460 if mm=0 or mm<sm then 13800
13470 re=(mi-1)*6+1
13480 rem read summary fields
13490 record#7,re,1:gosub 10100:nr$=r$:gosub 13200:nr$=r$
13500 record#7,re+1,1:gosub 10100:d$=r$:gosub 13200:d$=r$
13510 record#7,re+2,1:gosub 10100:fr$=r$:gosub 13200:fr$=r$
13520 record#7,re+3,1:gosub 10100:pt$=r$:gosub 13200:pt$=r$
13530 record#7,re+4,1:gosub 10100:su$=r$:gosub 13200:su$=r$
13540 record#7,re+5,1:gosub 10100:lc=val(r$)
13550 rem check summary visibility
13560 if at$<>"m" then 13620
13570 if mf$="#" then 13620
13580 un$=n$+" "+o$
13590 if fr$=un$ then 13620
13600 if pt$=un$ then 13620
13610 goto 13800
13620 rem display summary line
13630 fz$=fr$:pz$=pt$
13640 if len(fz$)>10 then fz$=left$(fz$,10)
13650 if len(pz$)>10 then pz$=left$(pz$,10)
13660 a$=str$(mm)+" "+str$(lc)+" "+d$
13670 a$=a$+" "+fz$+" "+pz$+" "+su$
13680 gosub 5040
13800 next mi
13820 return
13900 a$="no messages.":gosub 5040
13910 return
14000 rem read new messages
14010 gosub 5040
14020 a$="searching for new messages.....":gosub 5040
14030 gosub 5040
14040 nf=0
14050 nh=hm
14060 if mz=0 then 14400
14070 for ni=1 to mz
14080 mm=m(ni,1)
14090 if mm=0 then 14300
14100 if mm<=hm then 14300
14110 rem locate full message record
14120 re=1
14130 if ni=1 then 14170
14140 for nj=1 to ni-1
14150 re=re+m(nj,2)+6
14160 next nj
14180 rem check visibility
14190 record#3,re,1
14200 gosub 12200
14210 z$=r$
14220 gosub 13000
14230 if ok=0 then 14300
14240 rem visible new message
14260 nf=nf+1
14270 gosub 14500
14280 if mm>nh then nh=mm
14300 next ni
14310 if nf=0 then 14400
14320 hm=nh
14330 lr(ma)=hm
14340 gosub 10710
14350 return
14400 a$="no new messages.":gosub 5040
14410 return
14500 rem display selected new message
14510 re=1
14520 mi=1
14530 if mi>mz then return
14540 if m(mi,1)=mm then 14600
14550 re=re+m(mi,2)+6
14560 mi=mi+1
14570 goto 14530
14600 record#3,re+1,1:gosub 12200:d$=r$:gosub 13200:d$=r$
14610 record#3,re+2,1:gosub 12200:fr$=r$:gosub 13200:fr$=r$
14620 record#3,re+3,1:gosub 12200:pt$=r$:gosub 13200:pt$=r$
14630 record#3,re+4,1:gosub 12200:su$=r$:gosub 13200:su$=r$
14640 record#3,re+5,1:gosub 12200:lc=val(r$)
14650 gosub 5040
14660 a$="message:"+str$(mm):gosub 5040
14670 a$="date/time: "+d$:gosub 5040
14680 a$="from: "+fr$:gosub 5040
14690 a$="to: "+pt$:gosub 5040
14700 a$="subject: "+su$:gosub 5040
14710 gosub 5040
14720 for li=1 to lc
14730 record#3,re+5+li,1
14740 gosub 12200
14750 gosub 13200
14760 a$=r$:gosub 5040
14770 next li
14790 return
14800 rem reply to message
14805 gosub 5040
14810 if mc=0 or iu=0 then 14970
14815 a1$="reply to message ("+mid$(str$(iu),2)+"-"+mid$(str$(lm),2)+"): "
14820 n=1:gosub 5040
14825 c=1:ml=5:gosub 5170
14830 if cd then return
14835 if b$="" then return
14840 mm=val(b$)
14845 if mm<iu or mm>lm then 14980
14850 a$="searching.....":gosub 5040
14855 rem locate message
14860 mi=1:re=1
14865 if mi>mz then 14980
14870 if m(mi,1)=mm then 14890
14875 re=re+m(mi,2)+6
14880 mi=mi+1
14885 goto 14865
14890 rem read original sender and subject
14900 record#3,re,1
14905 gosub 12200
14910 z$=r$
14915 gosub 13000
14920 if ok=0 then 14990
14925 record#3,re+2,1
14930 gosub 12200
14935 fr$=r$:gosub 13200:fr$=r$
14940 record#3,re+4,1
14945 gosub 12200
14950 su$=r$:gosub 13200:su$=r$
14960 gosub 15100
14965 return
14970 a$="no messages.":gosub 5040:return
14980 a$="message not found.":gosub 5040:return
14990 a$="private message - access denied.":gosub 5040:return
15000 rem bulletins news and help - future
15010 return
15100 rem reply message entry
15105 t$=fr$
15110 k$=su$
15115 if left$(k$,3)="re:" then 15125
15120 k$="re: "+k$
15125 if len(k$)>26 then k$=left$(k$,26)
15130 gosub 5040
15135 a$="to: "+t$:gosub 5040
15140 a$="subject: "+k$:gosub 5040
15145 gosub 5040
15150 a$="enter up to 10 lines of text.":gosub 5040
15155 a$="enter a blank line when finished.":gosub 5040
15160 gosub 5040
15165 f=0
15170 if f=10 then 15250
15175 a1$=str$(f+1)+"> ":n=1:gosub 5040
15180 c=1:ml=63:gosub 5170
15185 if cd then return
15190 if b$="" then 15250
15195 f=f+1
15200 ms$(f)=b$
15205 goto 15170
15210 return
15250 if f=0 then 15290
15255 if at$="m" then pv=-1
15260 if at$<>"m" then pv=0
15265 d$=dd$+"/"+mo$+"/"+yr$+" "+left$(tm$,5)
15270 a$="saving reply.....":gosub 5040
15275 gosub 11500
15280 return
15290 a$="reply aborted.":gosub 5040
15295 return
15300 rem kill message
15310 gosub 5040
15320 if mc=0 or iu=0 then 15880
15330 a1$="kill message ("+mid$(str$(iu),2)+"-"+mid$(str$(lm),2)+"): "
15340 n=1:gosub 5040
15350 c=1:ml=5:gosub 5170
15360 if cd then return
15370 if b$="" then return
15380 mm=val(b$)
15390 if mm<iu or mm>lm then 15820
15400 a$="searching.....":gosub 5040
15410 rem locate message
15420 mi=1:re=1
15430 if mi>mz then 15820
15440 if m(mi,1)=mm then 15480
15450 re=re+m(mi,2)+6
15460 mi=mi+1
15470 goto 15430
15480 rem read sender
15500 record#3,re+2,1
15510 gosub 12200
15520 fr$=r$:gosub 13200:fr$=r$
15540 rem check delete ownership
15550 if mf$="#" then 15600
15560 un$=n$+" "+o$
15570 if fr$<>un$ then 15840
15600 rem confirm deletion
15610 a1$="are you sure (y/n)? ":n=1:gosub 5040
15620 c=1:ml=1:gosub 5170
15630 if cd then return
15640 if b$="" then 15610
15650 if asc(b$)=78 then 15860
15660 if asc(b$)<>89 then 15610
15670 rem mark summary deleted
15680 sr=(mi-1)*6+1
15700 rn=sr:r$="0"
15710 gosub 12000
15730 rem mark full message deleted
15750 rn=re:r$="0"
15760 gosub 12100
15780 rem update memory index
15790 m(mi,1)=0
15800 mc=mc-1
15810 if mc<0 then mc=0
15815 a$="message deleted.":gosub 5040
15818 return
15820 a$="message not found.":gosub 5040
15830 return
15840 a$="you may only delete your own messages.":gosub 5040
15850 return
15860 a$="message not deleted.":gosub 5040
15870 return
15880 a$="no messages.":gosub 5040
15890 return
15900 rem bulletins news and help - future
15910 return
15920 rem caller log and statistics - future
15930 return
16000 rem file area system - future
16010 return
17000 rem punter file transfers - future
17010 return
18000 rem doors and external programs - future
18010 return
19000 rem sysop chat and status window - future
19010 return
20000 rem ansi terminal support - future
20010 return
21000 rem reserved expansion
21010 return
22000 rem load ml string transmitter
22010 restore 22900
22020 for i=0 to 34
22030 read x
22040 poke 4864+i,x
22050 next i
22060 return
22070 return
22140 gosub 22400
22150 return
22200 rem benchmark arbitrary string ml tx
22210 a$=""
22220 restore 23100
22230 for i=1 to 48
22240 read x
22250 a$=a$+chr$(x)
22260 next i
22270 p=pointer(a$)
22280 bank 1
22290 ln=peek(p)
22300 q=peek(p+1)+256*peek(p+2)
22310 bank 15
22320 qh=int(q/256)
22330 ql=q-qh*256
22340 t0=ti
22350 for bt=1 to 20
22360 sys 4864,ql,qh,ln
22370 next bt
22380 t1=ti
22390 et=t1-t0
22400 if et<0 then et=et+5184000
22410 print "arbitrary ml tx:";et;" jiffies"
22420 return
22450 rem load generic ml rel writer
22460 restore 23800
22470 for i=0 to 45
22480 read x
22490 poke 5216+i,x
22500 next i
22510 return
22520 rem load ml local string display
22530 restore 24000
22540 for i=0 to 49
22550 read x
22560 poke 5280+i,x
22570 next i
22580 print "ml local display loaded"
22590 return
22750 next i
22760 print "sys parameter test loaded"
22770 return
22800 rem load generic ml rel reader
22810 restore 23600
22820 for i=0 to 34
22830 read x
22840 poke 5152+i,x
22850 next i
22860 return
22870 rem
22900 data 133,249,134,250,132,251
22910 data 160,0
22920 data 196,251,240,22
22930 data 169,249,162,1
22940 data 32,116,255
22950 data 72
22960 data 173,1,222
22970 data 41,16
22980 data 240,249
22990 data 104
23000 data 141,0,222
23010 data 200
23020 data 208,230
23030 data 96
23100 data 82,66,66,83,45,49,50,56
23110 data 32,77,65,67,72,73,78,69
23120 data 32,76,65,78,71,85,65,71,69
23130 data 32,79,85,84,80,85,84
23140 data 32,84,69,83,84
23150 data 32,49,50,51,52,53,54,55,56,57,48
23500 data 141,0,21
23510 data 142,1,21
23520 data 140,2,21
23530 data 96
23600 data 133,251,134,252
23610 data 166,253
23620 data 32,198,255
23630 data 169,251
23640 data 141,185,2
23650 data 160,0
23660 data 32,207,255
23670 data 72
23680 data 162,1
23690 data 104
23700 data 32,119,255
23710 data 200
23720 data 196,254
23730 data 208,241
23740 data 32,204,255
23750 data 96
23800 data 133,251,134,252,132,249
23810 data 166,253
23820 data 32,201,255
23830 data 160,0
23840 data 196,254
23850 data 240,25
23860 data 196,249
23870 data 176,13
23880 data 169,251
23890 data 162,1
23900 data 32,116,255
23910 data 32,210,255
23920 data 200
23930 data 208,235
23940 data 169,32
23950 data 32,210,255
23960 data 200
23970 data 208,227
23980 data 32,204,255
23990 data 96
24000 data 133,249,134,250,132,251
24010 data 169,0,133,252
24020 data 164,252,196,251,240,33
24030 data 169,249,162,1
24040 data 32,116,255
24050 data 201,32,144,18
24060 data 201,127,176,14
24070 data 201,97,144,7
24080 data 201,123,176,3
24090 data 56,233,32
24100 data 32,210,255
24110 data 230,252
24120 data 208,217
24130 data 96
40695 if b$="k" then gosub 15300:goto 4000